Code

Imported upstream version 1.3rc4.
[pkg-rrdtool.git] / bindings / tcl / tclrrd.c
1 /*
2  * tclrrd.c -- A TCL interpreter extension to access the RRD library.
3  *
4  * Copyright (c) 1999,2000 Frank Strauss, Technical University of Braunschweig.
5  *
6  * Thread-safe code copyright (c) 2005 Oleg Derevenetz, CenterTelecom Voronezh ISP.
7  *
8  * See the file "COPYING" for information on usage and redistribution
9  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10  *
11  * $Id: tclrrd.c 1306 2008-03-15 10:39:48Z oetiker $
12  */
16 #include <errno.h>
17 #include <string.h>
18 #include <time.h>
19 #include <unistd.h>
20 #include <tcl.h>
21 #include <stdlib.h>
22 #include "../../src/rrd_tool.h"
23 #include "../../src/rrd_format.h"
25 /* support pre-8.4 tcl */
27 #ifndef CONST84
28 #   define CONST84
29 #endif
31 extern int Tclrrd_Init(
32     Tcl_Interp *interp);
33 extern int Tclrrd_SafeInit(
34     Tcl_Interp *interp);
37 /*
38  * some rrd_XXX() and new thread-safe versions of Rrd_XXX()
39  * functions might modify the argv strings passed to it.
40  * Hence, we need to do some preparation before
41  * calling the rrd library functions.
42  */
43 static char **getopt_init(
44     int argc,
45     CONST84 char *argv[])
46 {
47     char    **argv2;
48     int       i;
50     argv2 = calloc(argc, sizeof(char *));
51     for (i = 0; i < argc; i++) {
52         argv2[i] = strdup(argv[i]);
53     }
54     return argv2;
55 }
57 static void getopt_cleanup(
58     int argc,
59     char **argv2)
60 {
61     int       i;
63     for (i = 0; i < argc; i++) {
64         if (argv2[i] != NULL) {
65             free(argv2[i]);
66         }
67     }
68     free(argv2);
69 }
71 static void getopt_free_element(
72     char *argv2[],
73     int argn)
74 {
75     if (argv2[argn] != NULL) {
76         free(argv2[argn]);
77         argv2[argn] = NULL;
78     }
79 }
81 static void getopt_squieeze(
82     int *argc,
83     char *argv2[])
84 {
85     int       i, null_i = 0, argc_tmp = *argc;
87     for (i = 0; i < argc_tmp; i++) {
88         if (argv2[i] == NULL) {
89             (*argc)--;
90         } else {
91             argv2[null_i++] = argv2[i];
92         }
93     }
94 }
98 /* Thread-safe version */
99 static int Rrd_Create(
100     ClientData clientData,
101     Tcl_Interp *interp,
102     int argc,
103     CONST84 char *argv[])
105     int       argv_i;
106     char    **argv2;
107     char     *parsetime_error = NULL;
108     time_t    last_up = time(NULL) - 10;
109     long int  long_tmp;
110     unsigned long int pdp_step = 300;
111     struct rrd_time_value last_up_tv;
113     argv2 = getopt_init(argc, argv);
115     for (argv_i = 1; argv_i < argc; argv_i++) {
116         if (!strcmp(argv2[argv_i], "--start") || !strcmp(argv2[argv_i], "-b")) {
117             if (argv_i++ >= argc) {
118                 Tcl_AppendResult(interp, "RRD Error: option '",
119                                  argv2[argv_i - 1], "' needs an argument",
120                                  (char *) NULL);
121                 getopt_cleanup(argc, argv2);
122                 return TCL_ERROR;
123             }
124             if ((parsetime_error = parsetime(argv2[argv_i], &last_up_tv))) {
125                 Tcl_AppendResult(interp, "RRD Error: invalid time format: '",
126                                  argv2[argv_i], "'", (char *) NULL);
127                 getopt_cleanup(argc, argv2);
128                 return TCL_ERROR;
129             }
130             if (last_up_tv.type == RELATIVE_TO_END_TIME ||
131                 last_up_tv.type == RELATIVE_TO_START_TIME) {
132                 Tcl_AppendResult(interp,
133                                  "RRD Error: specifying time relative to the 'start' ",
134                                  "or 'end' makes no sense here",
135                                  (char *) NULL);
136                 getopt_cleanup(argc, argv2);
137                 return TCL_ERROR;
138             }
139             last_up = mktime(&last_up_tv.tm) +last_up_tv.offset;
140             if (last_up < 3600 * 24 * 365 * 10) {
141                 Tcl_AppendResult(interp,
142                                  "RRD Error: the first entry to the RRD should be after 1980",
143                                  (char *) NULL);
144                 getopt_cleanup(argc, argv2);
145                 return TCL_ERROR;
146             }
147             getopt_free_element(argv2, argv_i - 1);
148             getopt_free_element(argv2, argv_i);
149         } else if (!strcmp(argv2[argv_i], "--step")
150                    || !strcmp(argv2[argv_i], "-s")) {
151             if (argv_i++ >= argc) {
152                 Tcl_AppendResult(interp, "RRD Error: option '",
153                                  argv2[argv_i - 1], "' needs an argument",
154                                  (char *) NULL);
155                 getopt_cleanup(argc, argv2);
156                 return TCL_ERROR;
157             }
158             long_tmp = atol(argv2[argv_i]);
159             if (long_tmp < 1) {
160                 Tcl_AppendResult(interp,
161                                  "RRD Error: step size should be no less than one second",
162                                  (char *) NULL);
163                 getopt_cleanup(argc, argv2);
164                 return TCL_ERROR;
165             }
166             pdp_step = long_tmp;
167             getopt_free_element(argv2, argv_i - 1);
168             getopt_free_element(argv2, argv_i);
169         } else if (!strcmp(argv2[argv_i], "--")) {
170             getopt_free_element(argv2, argv_i);
171             break;
172         } else if (argv2[argv_i][0] == '-') {
173             Tcl_AppendResult(interp, "RRD Error: unknown option '",
174                              argv2[argv_i], "'", (char *) NULL);
175             getopt_cleanup(argc, argv2);
176             return TCL_ERROR;
177         }
178     }
180     getopt_squieeze(&argc, argv2);
182     if (argc < 2) {
183         Tcl_AppendResult(interp, "RRD Error: needs rrd filename",
184                          (char *) NULL);
185         getopt_cleanup(argc, argv2);
186         return TCL_ERROR;
187     }
189     rrd_create_r(argv2[1], pdp_step, last_up, argc - 2, argv2 + 2);
191     getopt_cleanup(argc, argv2);
193     if (rrd_test_error()) {
194         Tcl_AppendResult(interp, "RRD Error: ",
195                          rrd_get_error(), (char *) NULL);
196         rrd_clear_error();
197         return TCL_ERROR;
198     }
200     return TCL_OK;
205 /* Thread-safe version */
206 static int Rrd_Dump(
207     ClientData clientData,
208     Tcl_Interp *interp,
209     int argc,
210     CONST84 char *argv[])
212     if (argc < 2) {
213         Tcl_AppendResult(interp, "RRD Error: needs rrd filename",
214                          (char *) NULL);
215         return TCL_ERROR;
216     }
218     rrd_dump_r(argv[1], NULL);
220     /* NOTE: rrd_dump() writes to stdout. No interaction with TCL. */
222     if (rrd_test_error()) {
223         Tcl_AppendResult(interp, "RRD Error: ",
224                          rrd_get_error(), (char *) NULL);
225         rrd_clear_error();
226         return TCL_ERROR;
227     }
229     return TCL_OK;
234 /* Thread-safe version */
235 static int Rrd_Last(
236     ClientData clientData,
237     Tcl_Interp *interp,
238     int argc,
239     CONST84 char *argv[])
241     time_t    t;
243     if (argc < 2) {
244         Tcl_AppendResult(interp, "RRD Error: needs rrd filename",
245                          (char *) NULL);
246         return TCL_ERROR;
247     }
249     t = rrd_last_r(argv[1]);
251     if (rrd_test_error()) {
252         Tcl_AppendResult(interp, "RRD Error: ",
253                          rrd_get_error(), (char *) NULL);
254         rrd_clear_error();
255         return TCL_ERROR;
256     }
258     Tcl_SetIntObj(Tcl_GetObjResult(interp), t);
260     return TCL_OK;
265 /* Thread-safe version */
266 static int Rrd_Update(
267     ClientData clientData,
268     Tcl_Interp *interp,
269     int argc,
270     CONST84 char *argv[])
272     int       argv_i;
273     char    **argv2, *template = NULL;
275     argv2 = getopt_init(argc, argv);
277     for (argv_i = 1; argv_i < argc; argv_i++) {
278         if (!strcmp(argv2[argv_i], "--template")
279             || !strcmp(argv2[argv_i], "-t")) {
280             if (argv_i++ >= argc) {
281                 Tcl_AppendResult(interp, "RRD Error: option '",
282                                  argv2[argv_i - 1], "' needs an argument",
283                                  (char *) NULL);
284                 if (template != NULL) {
285                     free(template);
286                 }
287                 getopt_cleanup(argc, argv2);
288                 return TCL_ERROR;
289             }
290             if (template != NULL) {
291                 free(template);
292             }
293             template = strdup(argv2[argv_i]);
294             getopt_free_element(argv2, argv_i - 1);
295             getopt_free_element(argv2, argv_i);
296         } else if (!strcmp(argv2[argv_i], "--")) {
297             getopt_free_element(argv2, argv_i);
298             break;
299         } else if (argv2[argv_i][0] == '-') {
300             Tcl_AppendResult(interp, "RRD Error: unknown option '",
301                              argv2[argv_i], "'", (char *) NULL);
302             if (template != NULL) {
303                 free(template);
304             }
305             getopt_cleanup(argc, argv2);
306             return TCL_ERROR;
307         }
308     }
310     getopt_squieeze(&argc, argv2);
312     if (argc < 2) {
313         Tcl_AppendResult(interp, "RRD Error: needs rrd filename",
314                          (char *) NULL);
315         if (template != NULL) {
316             free(template);
317         }
318         getopt_cleanup(argc, argv2);
319         return TCL_ERROR;
320     }
322     rrd_update_r(argv2[1], template, argc - 2, argv2 + 2);
324     if (template != NULL) {
325         free(template);
326     }
327     getopt_cleanup(argc, argv2);
329     if (rrd_test_error()) {
330         Tcl_AppendResult(interp, "RRD Error: ",
331                          rrd_get_error(), (char *) NULL);
332         rrd_clear_error();
333         return TCL_ERROR;
334     }
336     return TCL_OK;
339 static int Rrd_Lastupdate(
340     ClientData clientData,
341     Tcl_Interp *interp,
342     int argc,
343     CONST84 char *argv[])
345     time_t    last_update;
346     char    **argv2;
347     char    **ds_namv;
348     char    **last_ds;
349     char      s[30];
350     Tcl_Obj  *listPtr;
351     unsigned long ds_cnt, i;
353     argv2 = getopt_init(argc, argv);
354     if (rrd_lastupdate(argc - 1, argv2, &last_update,
355                        &ds_cnt, &ds_namv, &last_ds) == 0) {
356         listPtr = Tcl_GetObjResult(interp);
357         for (i = 0; i < ds_cnt; i++) {
358             sprintf(s, " %28s", ds_namv[i]);
359             Tcl_ListObjAppendElement(interp, listPtr,
360                                      Tcl_NewStringObj(s, -1));
361             sprintf(s, "\n\n%10lu:", last_update);
362             Tcl_ListObjAppendElement(interp, listPtr,
363                                      Tcl_NewStringObj(s, -1));
364             for (i = 0; i < ds_cnt; i++) {
365                 sprintf(s, " %s", last_ds[i]);
366                 Tcl_ListObjAppendElement(interp, listPtr,
367                                          Tcl_NewStringObj(s, -1));
368                 free(last_ds[i]);
369                 free(ds_namv[i]);
370             }
371             sprintf(s, "\n");
372             Tcl_ListObjAppendElement(interp, listPtr,
373                                      Tcl_NewStringObj(s, -1));
374             free(last_ds);
375             free(ds_namv);
376         }
377     }
378     return TCL_OK;
381 static int Rrd_Fetch(
382     ClientData clientData,
383     Tcl_Interp *interp,
384     int argc,
385     CONST84 char *argv[])
387     time_t    start, end, j;
388     unsigned long step, ds_cnt, i, ii;
389     rrd_value_t *data, *datai;
390     char    **ds_namv;
391     Tcl_Obj  *listPtr;
392     char      s[30];
393     char    **argv2;
395     argv2 = getopt_init(argc, argv);
396     if (rrd_fetch(argc, argv2, &start, &end, &step,
397                   &ds_cnt, &ds_namv, &data) != -1) {
398         datai = data;
399         listPtr = Tcl_GetObjResult(interp);
400         for (j = start; j <= end; j += step) {
401             for (ii = 0; ii < ds_cnt; ii++) {
402                 sprintf(s, "%.2f", *(datai++));
403                 Tcl_ListObjAppendElement(interp, listPtr,
404                                          Tcl_NewStringObj(s, -1));
405             }
406         }
407         for (i = 0; i < ds_cnt; i++)
408             free(ds_namv[i]);
409         free(ds_namv);
410         free(data);
411     }
412     getopt_cleanup(argc, argv2);
414     if (rrd_test_error()) {
415         Tcl_AppendResult(interp, "RRD Error: ",
416                          rrd_get_error(), (char *) NULL);
417         rrd_clear_error();
418         return TCL_ERROR;
419     }
421     return TCL_OK;
426 static int Rrd_Graph(
427     ClientData clientData,
428     Tcl_Interp *interp,
429     int argc,
430     CONST84 char *argv[])
432     Tcl_Channel channel;
433     int       mode, fd2;
434     ClientData fd1;
435     FILE     *stream = NULL;
436     char    **calcpr = NULL;
437     int       rc, xsize, ysize;
438     double    ymin, ymax;
439     char      dimensions[50];
440     char    **argv2;
441     CONST84 char *save;
443     /*
444      * If the "filename" is a Tcl fileID, then arrange for rrd_graph() to write to
445      * that file descriptor.  Will this work with windoze?  I have no idea.
446      */
447     if ((channel = Tcl_GetChannel(interp, argv[1], &mode)) != NULL) {
448         /*
449          * It >is< a Tcl fileID
450          */
451         if (!(mode & TCL_WRITABLE)) {
452             Tcl_AppendResult(interp, "channel \"", argv[1],
453                              "\" wasn't opened for writing", (char *) NULL);
454             return TCL_ERROR;
455         }
456         /*
457          * Must flush channel to make sure any buffered data is written before
458          * rrd_graph() writes to the stream
459          */
460         if (Tcl_Flush(channel) != TCL_OK) {
461             Tcl_AppendResult(interp, "flush failed for \"", argv[1], "\": ",
462                              strerror(Tcl_GetErrno()), (char *) NULL);
463             return TCL_ERROR;
464         }
465         if (Tcl_GetChannelHandle(channel, TCL_WRITABLE, &fd1) != TCL_OK) {
466             Tcl_AppendResult(interp,
467                              "cannot get file descriptor associated with \"",
468                              argv[1], "\"", (char *) NULL);
469             return TCL_ERROR;
470         }
471         /*
472          * Must dup() file descriptor so we can fclose(stream), otherwise the fclose()
473          * would close Tcl's file descriptor
474          */
475         if ((fd2 = dup((int) fd1)) == -1) {
476             Tcl_AppendResult(interp,
477                              "dup() failed for file descriptor associated with \"",
478                              argv[1], "\": ", strerror(errno), (char *) NULL);
479             return TCL_ERROR;
480         }
481         /*
482          * rrd_graph() wants a FILE*
483          */
484         if ((stream = fdopen(fd2, "wb")) == NULL) {
485             Tcl_AppendResult(interp,
486                              "fdopen() failed for file descriptor associated with \"",
487                              argv[1], "\": ", strerror(errno), (char *) NULL);
488             close(fd2); /* plug potential file descriptor leak */
489             return TCL_ERROR;
490         }
492         save = argv[1];
493         argv[1] = "-";
494         argv2 = getopt_init(argc, argv);
495         argv[1] = save;
496     } else {
497         Tcl_ResetResult(interp);    /* clear error from Tcl_GetChannel() */
498         argv2 = getopt_init(argc, argv);
499     }
501     rc = rrd_graph(argc, argv2, &calcpr, &xsize, &ysize, stream, &ymin,
502                    &ymax);
503     getopt_cleanup(argc, argv2);
505     if (stream != NULL)
506         fclose(stream); /* plug potential malloc & file descriptor leak */
508     if (rc != -1) {
509         sprintf(dimensions, "%d %d", xsize, ysize);
510         Tcl_AppendResult(interp, dimensions, (char *) NULL);
511         if (calcpr) {
512 #if 0
513             int       i;
515             for (i = 0; calcpr[i]; i++) {
516                 printf("%s\n", calcpr[i]);
517                 free(calcpr[i]);
518             }
519 #endif
520             free(calcpr);
521         }
522     }
524     if (rrd_test_error()) {
525         Tcl_AppendResult(interp, "RRD Error: ",
526                          rrd_get_error(), (char *) NULL);
527         rrd_clear_error();
528         return TCL_ERROR;
529     }
531     return TCL_OK;
536 static int Rrd_Tune(
537     ClientData clientData,
538     Tcl_Interp *interp,
539     int argc,
540     CONST84 char *argv[])
542     char    **argv2;
544     argv2 = getopt_init(argc, argv);
545     rrd_tune(argc, argv2);
546     getopt_cleanup(argc, argv2);
548     if (rrd_test_error()) {
549         Tcl_AppendResult(interp, "RRD Error: ",
550                          rrd_get_error(), (char *) NULL);
551         rrd_clear_error();
552         return TCL_ERROR;
553     }
555     return TCL_OK;
560 static int Rrd_Resize(
561     ClientData clientData,
562     Tcl_Interp *interp,
563     int argc,
564     CONST84 char *argv[])
566     char    **argv2;
568     argv2 = getopt_init(argc, argv);
569     rrd_resize(argc, argv2);
570     getopt_cleanup(argc, argv2);
572     if (rrd_test_error()) {
573         Tcl_AppendResult(interp, "RRD Error: ",
574                          rrd_get_error(), (char *) NULL);
575         rrd_clear_error();
576         return TCL_ERROR;
577     }
579     return TCL_OK;
584 static int Rrd_Restore(
585     ClientData clientData,
586     Tcl_Interp *interp,
587     int argc,
588     CONST84 char *argv[])
590     char    **argv2;
592     argv2 = getopt_init(argc, argv);
593     rrd_restore(argc, argv2);
594     getopt_cleanup(argc, argv2);
596     if (rrd_test_error()) {
597         Tcl_AppendResult(interp, "RRD Error: ",
598                          rrd_get_error(), (char *) NULL);
599         rrd_clear_error();
600         return TCL_ERROR;
601     }
603     return TCL_OK;
608 /*
609  * The following structure defines the commands in the Rrd extension.
610  */
612 typedef struct {
613     char     *name;     /* Name of the command. */
614     Tcl_CmdProc *proc;  /* Procedure for command. */
615     int       hide;     /* Hide if safe interpreter */
616 } CmdInfo;
618 static CmdInfo rrdCmds[] = {
619     {"Rrd::create", Rrd_Create, 1}, /* Thread-safe version */
620     {"Rrd::dump", Rrd_Dump, 0}, /* Thread-safe version */
621     {"Rrd::last", Rrd_Last, 0}, /* Thread-safe version */
622     {"Rrd::lastupdate", Rrd_Lastupdate, 0}, /* Thread-safe version */
623     {"Rrd::update", Rrd_Update, 1}, /* Thread-safe version */
624     {"Rrd::fetch", Rrd_Fetch, 0},
625     {"Rrd::graph", Rrd_Graph, 1},   /* Due to RRD's API, a safe
626                                        interpreter cannot create
627                                        a graph since it writes to
628                                        a filename supplied by the
629                                        caller */
630     {"Rrd::tune", Rrd_Tune, 1},
631     {"Rrd::resize", Rrd_Resize, 1},
632     {"Rrd::restore", Rrd_Restore, 1},
633     {(char *) NULL, (Tcl_CmdProc *) NULL, 0}
634 };
638 static int init(
639     Tcl_Interp *interp,
640     int safe)
642     CmdInfo  *cmdInfoPtr;
643     Tcl_CmdInfo info;
645     if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL)
646         return TCL_ERROR;
648     if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
649         return TCL_ERROR;
650     }
652     /*
653      * Why a global array?  In keeping with the Rrd:: namespace, why
654      * not simply create a normal variable Rrd::version and set it?
655      */
656     Tcl_SetVar2(interp, "rrd", "version", VERSION, TCL_GLOBAL_ONLY);
658     for (cmdInfoPtr = rrdCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
659         /*
660          * Check if the command already exists and return an error
661          * to ensure we detect name clashes while loading the Rrd
662          * extension.
663          */
664         if (Tcl_GetCommandInfo(interp, cmdInfoPtr->name, &info)) {
665             Tcl_AppendResult(interp, "command \"", cmdInfoPtr->name,
666                              "\" already exists", (char *) NULL);
667             return TCL_ERROR;
668         }
669         if (safe && cmdInfoPtr->hide) {
670 #if 0
671             /*
672              * Turns out the one cannot hide a command in a namespace
673              * due to a limitation of Tcl, one can only hide global
674              * commands.  Thus, if we created the commands without
675              * the Rrd:: namespace in a safe interpreter, then the
676              * "unsafe" commands could be hidden -- which would allow
677              * an owning interpreter either un-hiding them or doing
678              * an "interp invokehidden".  If the Rrd:: namespace is
679              * used, then it's still possible for the owning interpreter
680              * to fake out the missing commands:
681              *
682              *   # Make all Rrd::* commands available in master interperter
683              *   package require Rrd
684              *   set safe [interp create -safe]
685              *   # Make safe Rrd::* commands available in safe interperter
686              *   interp invokehidden $safe -global load ./tclrrd1.2.11.so
687              *   # Provide the safe interpreter with the missing commands
688              *   $safe alias Rrd::update do_update $safe
689              *   proc do_update {which_interp $args} {
690              *     # Do some checking maybe...
691              *       :
692              *     return [eval Rrd::update $args]
693              *   }
694              *
695              * Our solution for now is to just not create the "unsafe"
696              * commands in a safe interpreter.
697              */
698             if (Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name) !=
699                 TCL_OK)
700                 return TCL_ERROR;
701 #endif
702         } else
703             Tcl_CreateCommand(interp, cmdInfoPtr->name, cmdInfoPtr->proc,
704                               (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
705     }
707     if (Tcl_PkgProvide(interp, "Rrd", VERSION) != TCL_OK) {
708         return TCL_ERROR;
709     }
711     return TCL_OK;
714 int Tclrrd_Init(
715     Tcl_Interp *interp)
717     return init(interp, 0);
720 /*
721  * See the comments above and note how few commands are considered "safe"...
722  * Using rrdtool in a safe interpreter has very limited functionality.  It's
723  * tempting to just return TCL_ERROR and forget about it.
724  */
725 int Tclrrd_SafeInit(
726     Tcl_Interp *interp)
728     return init(interp, 1);