2 * tclrrd.c -- A TCL interpreter extension to access the RRD library.
4 * Copyright (c) 1999,2000 Frank Strauss, Technical University of Braunschweig.
6 * Thread-safe code copyright (c) 2005 Oleg Derevenetz, CenterTelecom Voronezh ISP.
8 * See the file "COPYING" for information on usage and redistribution
9 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
22 #include <rrd_format.h>
24 /* support pre-8.4 tcl */
30 extern int Tclrrd_Init(Tcl_Interp *interp);
31 extern int Tclrrd_SafeInit(Tcl_Interp *interp);
35 * some rrd_XXX() and new thread-safe versions of Rrd_XXX()
36 * functions might modify the argv strings passed to it.
37 * Hence, we need to do some preparation before
38 * calling the rrd library functions.
40 static char ** getopt_init(int argc, CONST84 char *argv[])
45 argv2 = calloc(argc, sizeof(char *));
46 for (i = 0; i < argc; i++) {
47 argv2[i] = strdup(argv[i]);
52 static void getopt_cleanup(int argc, char **argv2)
56 for (i = 0; i < argc; i++) {
57 if (argv2[i] != NULL) {
64 static void getopt_free_element(argv2, argn)
68 if (argv2[argn] != NULL) {
74 static void getopt_squieeze(argc, argv2)
78 int i, null_i = 0, argc_tmp = *argc;
80 for (i = 0; i < argc_tmp; i++) {
81 if (argv2[i] == NULL) {
84 argv2[null_i++] = argv2[i];
91 /* Thread-safe version */
93 Rrd_Create(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
97 char *parsetime_error = NULL;
98 time_t last_up = time(NULL) - 10;
100 unsigned long int pdp_step = 300;
101 struct rrd_time_value last_up_tv;
103 argv2 = getopt_init(argc, argv);
105 for (argv_i = 1; argv_i < argc; argv_i++) {
106 if (!strcmp(argv2[argv_i], "--start") || !strcmp(argv2[argv_i], "-b")) {
107 if (argv_i++>=argc) {
108 Tcl_AppendResult(interp, "RRD Error: option '",
109 argv2[argv_i - 1], "' needs an argument", (char *) NULL);
110 getopt_cleanup(argc, argv2);
113 if ((parsetime_error = parsetime(argv2[argv_i], &last_up_tv))) {
114 Tcl_AppendResult(interp, "RRD Error: invalid time format: '",
115 argv2[argv_i], "'", (char *) NULL);
116 getopt_cleanup(argc, argv2);
119 if (last_up_tv.type == RELATIVE_TO_END_TIME ||
120 last_up_tv.type == RELATIVE_TO_START_TIME) {
121 Tcl_AppendResult(interp, "RRD Error: specifying time relative to the 'start' ",
122 "or 'end' makes no sense here", (char *) NULL);
123 getopt_cleanup(argc, argv2);
126 last_up = mktime(&last_up_tv.tm) + last_up_tv.offset;
127 if (last_up < 3600*24*365*10) {
128 Tcl_AppendResult(interp, "RRD Error: the first entry to the RRD should be after 1980",
130 getopt_cleanup(argc, argv2);
133 getopt_free_element(argv2, argv_i - 1);
134 getopt_free_element(argv2, argv_i);
135 } else if (!strcmp(argv2[argv_i], "--step") || !strcmp(argv2[argv_i], "-s")) {
136 if (argv_i++>=argc) {
137 Tcl_AppendResult(interp, "RRD Error: option '",
138 argv2[argv_i - 1], "' needs an argument", (char *) NULL);
139 getopt_cleanup(argc, argv2);
142 long_tmp = atol(argv2[argv_i]);
144 Tcl_AppendResult(interp, "RRD Error: step size should be no less than one second",
146 getopt_cleanup(argc, argv2);
150 getopt_free_element(argv2, argv_i - 1);
151 getopt_free_element(argv2, argv_i);
152 } else if (!strcmp(argv2[argv_i], "--")) {
153 getopt_free_element(argv2, argv_i);
155 } else if (argv2[argv_i][0]=='-') {
156 Tcl_AppendResult(interp, "RRD Error: unknown option '",
157 argv2[argv_i], "'", (char *) NULL);
158 getopt_cleanup(argc, argv2);
163 getopt_squieeze(&argc, argv2);
166 Tcl_AppendResult(interp, "RRD Error: needs rrd filename",
168 getopt_cleanup(argc, argv2);
172 rrd_create_r(argv2[1], pdp_step, last_up, argc - 2, argv2 + 2);
174 getopt_cleanup(argc, argv2);
176 if (rrd_test_error()) {
177 Tcl_AppendResult(interp, "RRD Error: ",
178 rrd_get_error(), (char *) NULL);
188 /* Thread-safe version */
190 Rrd_Dump(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
193 Tcl_AppendResult(interp, "RRD Error: needs rrd filename",
198 rrd_dump_r(argv[1], NULL);
200 /* NOTE: rrd_dump() writes to stdout. No interaction with TCL. */
202 if (rrd_test_error()) {
203 Tcl_AppendResult(interp, "RRD Error: ",
204 rrd_get_error(), (char *) NULL);
214 /* Thread-safe version */
216 Rrd_Last(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
221 Tcl_AppendResult(interp, "RRD Error: needs rrd filename",
226 t = rrd_last_r(argv[1]);
228 if (rrd_test_error()) {
229 Tcl_AppendResult(interp, "RRD Error: ",
230 rrd_get_error(), (char *) NULL);
235 Tcl_SetIntObj(Tcl_GetObjResult(interp), t);
242 /* Thread-safe version */
244 Rrd_Update(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
247 char **argv2, *template = NULL;
249 argv2 = getopt_init(argc, argv);
251 for (argv_i = 1; argv_i < argc; argv_i++) {
252 if (!strcmp(argv2[argv_i], "--template") || !strcmp(argv2[argv_i], "-t")) {
253 if (argv_i++>=argc) {
254 Tcl_AppendResult(interp, "RRD Error: option '",
255 argv2[argv_i - 1], "' needs an argument", (char *) NULL);
256 if (template != NULL) {
259 getopt_cleanup(argc, argv2);
262 if (template != NULL) {
265 template = strdup(argv2[argv_i]);
266 getopt_free_element(argv2, argv_i - 1);
267 getopt_free_element(argv2, argv_i);
268 } else if (!strcmp(argv2[argv_i], "--")) {
269 getopt_free_element(argv2, argv_i);
271 } else if (argv2[argv_i][0]=='-') {
272 Tcl_AppendResult(interp, "RRD Error: unknown option '",
273 argv2[argv_i], "'", (char *) NULL);
274 if (template != NULL) {
277 getopt_cleanup(argc, argv2);
282 getopt_squieeze(&argc, argv2);
285 Tcl_AppendResult(interp, "RRD Error: needs rrd filename",
287 if (template != NULL) {
290 getopt_cleanup(argc, argv2);
294 rrd_update_r(argv2[1], template, argc - 2, argv2 + 2);
296 if (template != NULL) {
299 getopt_cleanup(argc, argv2);
301 if (rrd_test_error()) {
302 Tcl_AppendResult(interp, "RRD Error: ",
303 rrd_get_error(), (char *) NULL);
314 Rrd_Fetch(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
316 time_t start, end, j;
317 unsigned long step, ds_cnt, i, ii;
318 rrd_value_t *data, *datai;
324 argv2 = getopt_init(argc, argv);
325 if (rrd_fetch(argc, argv2, &start, &end, &step,
326 &ds_cnt, &ds_namv, &data) != -1) {
328 listPtr = Tcl_GetObjResult(interp);
329 for (j = start; j <= end; j += step) {
330 for (ii = 0; ii < ds_cnt; ii++) {
331 sprintf(s, "%.2f", *(datai++));
332 Tcl_ListObjAppendElement(interp, listPtr,
333 Tcl_NewStringObj(s, -1));
336 for (i=0; i<ds_cnt; i++) free(ds_namv[i]);
340 getopt_cleanup(argc, argv2);
342 if (rrd_test_error()) {
343 Tcl_AppendResult(interp, "RRD Error: ",
344 rrd_get_error(), (char *) NULL);
355 Rrd_Graph(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
361 char **calcpr = NULL;
362 int rc, xsize, ysize;
369 * If the "filename" is a Tcl fileID, then arrange for rrd_graph() to write to
370 * that file descriptor. Will this work with windoze? I have no idea.
372 if ((channel = Tcl_GetChannel(interp, argv[1], &mode)) != NULL) {
374 * It >is< a Tcl fileID
376 if (!(mode & TCL_WRITABLE)) {
377 Tcl_AppendResult(interp, "channel \"", argv[1],
378 "\" wasn't opened for writing", (char *) NULL);
382 * Must flush channel to make sure any buffered data is written before
383 * rrd_graph() writes to the stream
385 if (Tcl_Flush(channel) != TCL_OK) {
386 Tcl_AppendResult(interp, "flush failed for \"", argv[1], "\": ",
387 strerror(Tcl_GetErrno()), (char *) NULL);
390 if (Tcl_GetChannelHandle(channel, TCL_WRITABLE, &fd1) != TCL_OK) {
391 Tcl_AppendResult(interp, "cannot get file descriptor associated with \"",
392 argv[1], "\"", (char *) NULL);
396 * Must dup() file descriptor so we can fclose(stream), otherwise the fclose()
397 * would close Tcl's file descriptor
399 if ((fd2 = dup((int)fd1)) == -1) {
400 Tcl_AppendResult(interp, "dup() failed for file descriptor associated with \"",
401 argv[1], "\": ", strerror(errno), (char *) NULL);
405 * rrd_graph() wants a FILE*
407 if ((stream = fdopen(fd2, "wb")) == NULL) {
408 Tcl_AppendResult(interp, "fdopen() failed for file descriptor associated with \"",
409 argv[1], "\": ", strerror(errno), (char *) NULL);
410 close(fd2); /* plug potential file descriptor leak */
416 argv2 = getopt_init(argc, argv);
419 Tcl_ResetResult(interp); /* clear error from Tcl_GetChannel() */
420 argv2 = getopt_init(argc, argv);
423 rc = rrd_graph(argc, argv2, &calcpr, &xsize, &ysize, stream, &ymin, &ymax);
424 getopt_cleanup(argc, argv2);
427 fclose(stream); /* plug potential malloc & file descriptor leak */
430 sprintf(dimensions, "%d %d", xsize, ysize);
431 Tcl_AppendResult(interp, dimensions, (char *) NULL);
436 for(i = 0; calcpr[i]; i++){
437 printf("%s\n", calcpr[i]);
445 if (rrd_test_error()) {
446 Tcl_AppendResult(interp, "RRD Error: ",
447 rrd_get_error(), (char *) NULL);
458 Rrd_Tune(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
462 argv2 = getopt_init(argc, argv);
463 rrd_tune(argc, argv2);
464 getopt_cleanup(argc, argv2);
466 if (rrd_test_error()) {
467 Tcl_AppendResult(interp, "RRD Error: ",
468 rrd_get_error(), (char *) NULL);
479 Rrd_Resize(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
483 argv2 = getopt_init(argc, argv);
484 rrd_resize(argc, argv2);
485 getopt_cleanup(argc, argv2);
487 if (rrd_test_error()) {
488 Tcl_AppendResult(interp, "RRD Error: ",
489 rrd_get_error(), (char *) NULL);
500 Rrd_Restore(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
504 argv2 = getopt_init(argc, argv);
505 rrd_restore(argc, argv2);
506 getopt_cleanup(argc, argv2);
508 if (rrd_test_error()) {
509 Tcl_AppendResult(interp, "RRD Error: ",
510 rrd_get_error(), (char *) NULL);
521 * The following structure defines the commands in the Rrd extension.
525 char *name; /* Name of the command. */
526 Tcl_CmdProc *proc; /* Procedure for command. */
527 int hide; /* Hide if safe interpreter */
530 static CmdInfo rrdCmds[] = {
531 { "Rrd::create", Rrd_Create, 1 }, /* Thread-safe version */
532 { "Rrd::dump", Rrd_Dump, 0 }, /* Thread-safe version */
533 { "Rrd::last", Rrd_Last, 0 }, /* Thread-safe version */
534 { "Rrd::update", Rrd_Update, 1 }, /* Thread-safe version */
535 { "Rrd::fetch", Rrd_Fetch, 0 },
536 { "Rrd::graph", Rrd_Graph, 1 }, /* Due to RRD's API, a safe
537 interpreter cannot create
538 a graph since it writes to
539 a filename supplied by the
541 { "Rrd::tune", Rrd_Tune, 1 },
542 { "Rrd::resize", Rrd_Resize, 1 },
543 { "Rrd::restore", Rrd_Restore, 1 },
544 { (char *) NULL, (Tcl_CmdProc *) NULL, 0 }
550 init(Tcl_Interp *interp, int safe)
555 if ( Tcl_InitStubs(interp,TCL_VERSION,0) == NULL )
558 if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
563 * Why a global array? In keeping with the Rrd:: namespace, why
564 * not simply create a normal variable Rrd::version and set it?
566 Tcl_SetVar2(interp, "rrd", "version", VERSION, TCL_GLOBAL_ONLY);
568 for (cmdInfoPtr = rrdCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
570 * Check if the command already exists and return an error
571 * to ensure we detect name clashes while loading the Rrd
574 if (Tcl_GetCommandInfo(interp, cmdInfoPtr->name, &info)) {
575 Tcl_AppendResult(interp, "command \"", cmdInfoPtr->name,
576 "\" already exists", (char *) NULL);
579 if (safe && cmdInfoPtr->hide) {
582 * Turns out the one cannot hide a command in a namespace
583 * due to a limitation of Tcl, one can only hide global
584 * commands. Thus, if we created the commands without
585 * the Rrd:: namespace in a safe interpreter, then the
586 * "unsafe" commands could be hidden -- which would allow
587 * an owning interpreter either un-hiding them or doing
588 * an "interp invokehidden". If the Rrd:: namespace is
589 * used, then it's still possible for the owning interpreter
590 * to fake out the missing commands:
592 * # Make all Rrd::* commands available in master interperter
593 * package require Rrd
594 * set safe [interp create -safe]
595 * # Make safe Rrd::* commands available in safe interperter
596 * interp invokehidden $safe -global load ./tclrrd1.2.11.so
597 * # Provide the safe interpreter with the missing commands
598 * $safe alias Rrd::update do_update $safe
599 * proc do_update {which_interp $args} {
600 * # Do some checking maybe...
602 * return [eval Rrd::update $args]
605 * Our solution for now is to just not create the "unsafe"
606 * commands in a safe interpreter.
608 if (Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name) != TCL_OK)
613 Tcl_CreateCommand(interp, cmdInfoPtr->name, cmdInfoPtr->proc,
614 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
617 if (Tcl_PkgProvide(interp, "Rrd", VERSION) != TCL_OK) {
625 Tclrrd_Init(Tcl_Interp *interp)
627 return init(interp, 0);
631 * See the comments above and note how few commands are considered "safe"...
632 * Using rrdtool in a safe interpreter has very limited functionality. It's
633 * tempting to just return TCL_ERROR and forget about it.
636 Tclrrd_SafeInit(Tcl_Interp *interp)
638 return init(interp, 1);