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.
21 #include "../../src/rrd_tool.h"
22 #include "../../src/rrd_format.h"
24 /* support pre-8.4 tcl */
30 extern int Tclrrd_Init(
32 extern int Tclrrd_SafeInit(
37 * some rrd_XXX() and new thread-safe versions of Rrd_XXX()
38 * functions might modify the argv strings passed to it.
39 * Hence, we need to do some preparation before
40 * calling the rrd library functions.
42 static char **getopt_init(
49 argv2 = calloc(argc, sizeof(char *));
50 for (i = 0; i < argc; i++) {
51 argv2[i] = strdup(argv[i]);
56 static void getopt_cleanup(
62 for (i = 0; i < argc; i++) {
63 if (argv2[i] != NULL) {
70 static void getopt_free_element(
76 if (argv2[argn] != NULL) {
82 static void getopt_squieeze(
88 int i, null_i = 0, argc_tmp = *argc;
90 for (i = 0; i < argc_tmp; i++) {
91 if (argv2[i] == NULL) {
94 argv2[null_i++] = argv2[i];
101 /* Thread-safe version */
102 static int Rrd_Create(
103 ClientData clientData,
106 CONST84 char *argv[])
110 char *parsetime_error = NULL;
111 time_t last_up = time(NULL) - 10;
113 unsigned long int pdp_step = 300;
114 struct rrd_time_value last_up_tv;
116 argv2 = getopt_init(argc, argv);
118 for (argv_i = 1; argv_i < argc; argv_i++) {
119 if (!strcmp(argv2[argv_i], "--start") || !strcmp(argv2[argv_i], "-b")) {
120 if (argv_i++ >= argc) {
121 Tcl_AppendResult(interp, "RRD Error: option '",
122 argv2[argv_i - 1], "' needs an argument",
124 getopt_cleanup(argc, argv2);
127 if ((parsetime_error = parsetime(argv2[argv_i], &last_up_tv))) {
128 Tcl_AppendResult(interp, "RRD Error: invalid time format: '",
129 argv2[argv_i], "'", (char *) NULL);
130 getopt_cleanup(argc, argv2);
133 if (last_up_tv.type == RELATIVE_TO_END_TIME ||
134 last_up_tv.type == RELATIVE_TO_START_TIME) {
135 Tcl_AppendResult(interp,
136 "RRD Error: specifying time relative to the 'start' ",
137 "or 'end' makes no sense here",
139 getopt_cleanup(argc, argv2);
142 last_up = mktime(&last_up_tv.tm) +last_up_tv.offset;
143 if (last_up < 3600 * 24 * 365 * 10) {
144 Tcl_AppendResult(interp,
145 "RRD Error: the first entry to the RRD should be after 1980",
147 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], "--step")
153 || !strcmp(argv2[argv_i], "-s")) {
154 if (argv_i++ >= argc) {
155 Tcl_AppendResult(interp, "RRD Error: option '",
156 argv2[argv_i - 1], "' needs an argument",
158 getopt_cleanup(argc, argv2);
161 long_tmp = atol(argv2[argv_i]);
163 Tcl_AppendResult(interp,
164 "RRD Error: step size should be no less than one second",
166 getopt_cleanup(argc, argv2);
170 getopt_free_element(argv2, argv_i - 1);
171 getopt_free_element(argv2, argv_i);
172 } else if (!strcmp(argv2[argv_i], "--")) {
173 getopt_free_element(argv2, argv_i);
175 } else if (argv2[argv_i][0] == '-') {
176 Tcl_AppendResult(interp, "RRD Error: unknown option '",
177 argv2[argv_i], "'", (char *) NULL);
178 getopt_cleanup(argc, argv2);
183 getopt_squieeze(&argc, argv2);
186 Tcl_AppendResult(interp, "RRD Error: needs rrd filename",
188 getopt_cleanup(argc, argv2);
192 rrd_create_r(argv2[1], pdp_step, last_up, argc - 2, argv2 + 2);
194 getopt_cleanup(argc, argv2);
196 if (rrd_test_error()) {
197 Tcl_AppendResult(interp, "RRD Error: ",
198 rrd_get_error(), (char *) NULL);
208 /* Thread-safe version */
210 ClientData clientData,
213 CONST84 char *argv[])
216 Tcl_AppendResult(interp, "RRD Error: needs rrd filename",
221 rrd_dump_r(argv[1], NULL);
223 /* NOTE: rrd_dump() writes to stdout. No interaction with TCL. */
225 if (rrd_test_error()) {
226 Tcl_AppendResult(interp, "RRD Error: ",
227 rrd_get_error(), (char *) NULL);
237 /* Thread-safe version */
239 ClientData clientData,
242 CONST84 char *argv[])
247 Tcl_AppendResult(interp, "RRD Error: needs rrd filename",
252 t = rrd_last_r(argv[1]);
254 if (rrd_test_error()) {
255 Tcl_AppendResult(interp, "RRD Error: ",
256 rrd_get_error(), (char *) NULL);
261 Tcl_SetIntObj(Tcl_GetObjResult(interp), t);
268 /* Thread-safe version */
269 static int Rrd_Update(
270 ClientData clientData,
273 CONST84 char *argv[])
276 char **argv2, *template = NULL;
278 argv2 = getopt_init(argc, argv);
280 for (argv_i = 1; argv_i < argc; argv_i++) {
281 if (!strcmp(argv2[argv_i], "--template")
282 || !strcmp(argv2[argv_i], "-t")) {
283 if (argv_i++ >= argc) {
284 Tcl_AppendResult(interp, "RRD Error: option '",
285 argv2[argv_i - 1], "' needs an argument",
287 if (template != NULL) {
290 getopt_cleanup(argc, argv2);
293 if (template != NULL) {
296 template = strdup(argv2[argv_i]);
297 getopt_free_element(argv2, argv_i - 1);
298 getopt_free_element(argv2, argv_i);
299 } else if (!strcmp(argv2[argv_i], "--")) {
300 getopt_free_element(argv2, argv_i);
302 } else if (argv2[argv_i][0] == '-') {
303 Tcl_AppendResult(interp, "RRD Error: unknown option '",
304 argv2[argv_i], "'", (char *) NULL);
305 if (template != NULL) {
308 getopt_cleanup(argc, argv2);
313 getopt_squieeze(&argc, argv2);
316 Tcl_AppendResult(interp, "RRD Error: needs rrd filename",
318 if (template != NULL) {
321 getopt_cleanup(argc, argv2);
325 rrd_update_r(argv2[1], template, argc - 2, argv2 + 2);
327 if (template != NULL) {
330 getopt_cleanup(argc, argv2);
332 if (rrd_test_error()) {
333 Tcl_AppendResult(interp, "RRD Error: ",
334 rrd_get_error(), (char *) NULL);
342 static int Rrd_Lastupdate(
343 ClientData clientData,
346 CONST84 char *argv[])
354 unsigned long ds_cnt, i;
356 argv2 = getopt_init(argc, argv);
357 if (rrd_lastupdate(argc - 1, argv2, &last_update,
358 &ds_cnt, &ds_namv, &last_ds) == 0) {
359 listPtr = Tcl_GetObjResult(interp);
360 for (i = 0; i < ds_cnt; i++) {
361 sprintf(s, " %28s", ds_namv[i]);
362 Tcl_ListObjAppendElement(interp, listPtr,
363 Tcl_NewStringObj(s, -1));
364 sprintf(s, "\n\n%10lu:", last_update);
365 Tcl_ListObjAppendElement(interp, listPtr,
366 Tcl_NewStringObj(s, -1));
367 for (i = 0; i < ds_cnt; i++) {
368 sprintf(s, " %s", last_ds[i]);
369 Tcl_ListObjAppendElement(interp, listPtr,
370 Tcl_NewStringObj(s, -1));
375 Tcl_ListObjAppendElement(interp, listPtr,
376 Tcl_NewStringObj(s, -1));
384 static int Rrd_Fetch(
385 ClientData clientData,
388 CONST84 char *argv[])
390 time_t start, end, j;
391 unsigned long step, ds_cnt, i, ii;
392 rrd_value_t *data, *datai;
398 argv2 = getopt_init(argc, argv);
399 if (rrd_fetch(argc, argv2, &start, &end, &step,
400 &ds_cnt, &ds_namv, &data) != -1) {
402 listPtr = Tcl_GetObjResult(interp);
403 for (j = start; j <= end; j += step) {
404 for (ii = 0; ii < ds_cnt; ii++) {
405 sprintf(s, "%.2f", *(datai++));
406 Tcl_ListObjAppendElement(interp, listPtr,
407 Tcl_NewStringObj(s, -1));
410 for (i = 0; i < ds_cnt; i++)
415 getopt_cleanup(argc, argv2);
417 if (rrd_test_error()) {
418 Tcl_AppendResult(interp, "RRD Error: ",
419 rrd_get_error(), (char *) NULL);
429 static int Rrd_Graph(
430 ClientData clientData,
433 CONST84 char *argv[])
439 char **calcpr = NULL;
440 int rc, xsize, ysize;
447 * If the "filename" is a Tcl fileID, then arrange for rrd_graph() to write to
448 * that file descriptor. Will this work with windoze? I have no idea.
450 if ((channel = Tcl_GetChannel(interp, argv[1], &mode)) != NULL) {
452 * It >is< a Tcl fileID
454 if (!(mode & TCL_WRITABLE)) {
455 Tcl_AppendResult(interp, "channel \"", argv[1],
456 "\" wasn't opened for writing", (char *) NULL);
460 * Must flush channel to make sure any buffered data is written before
461 * rrd_graph() writes to the stream
463 if (Tcl_Flush(channel) != TCL_OK) {
464 Tcl_AppendResult(interp, "flush failed for \"", argv[1], "\": ",
465 strerror(Tcl_GetErrno()), (char *) NULL);
468 if (Tcl_GetChannelHandle(channel, TCL_WRITABLE, &fd1) != TCL_OK) {
469 Tcl_AppendResult(interp,
470 "cannot get file descriptor associated with \"",
471 argv[1], "\"", (char *) NULL);
475 * Must dup() file descriptor so we can fclose(stream), otherwise the fclose()
476 * would close Tcl's file descriptor
478 if ((fd2 = dup((int) fd1)) == -1) {
479 Tcl_AppendResult(interp,
480 "dup() failed for file descriptor associated with \"",
481 argv[1], "\": ", strerror(errno), (char *) NULL);
485 * rrd_graph() wants a FILE*
487 if ((stream = fdopen(fd2, "wb")) == NULL) {
488 Tcl_AppendResult(interp,
489 "fdopen() failed for file descriptor associated with \"",
490 argv[1], "\": ", strerror(errno), (char *) NULL);
491 close(fd2); /* plug potential file descriptor leak */
497 argv2 = getopt_init(argc, argv);
500 Tcl_ResetResult(interp); /* clear error from Tcl_GetChannel() */
501 argv2 = getopt_init(argc, argv);
504 rc = rrd_graph(argc, argv2, &calcpr, &xsize, &ysize, stream, &ymin,
506 getopt_cleanup(argc, argv2);
509 fclose(stream); /* plug potential malloc & file descriptor leak */
512 sprintf(dimensions, "%d %d", xsize, ysize);
513 Tcl_AppendResult(interp, dimensions, (char *) NULL);
518 for (i = 0; calcpr[i]; i++) {
519 printf("%s\n", calcpr[i]);
527 if (rrd_test_error()) {
528 Tcl_AppendResult(interp, "RRD Error: ",
529 rrd_get_error(), (char *) NULL);
540 ClientData clientData,
543 CONST84 char *argv[])
547 argv2 = getopt_init(argc, argv);
548 rrd_tune(argc, argv2);
549 getopt_cleanup(argc, argv2);
551 if (rrd_test_error()) {
552 Tcl_AppendResult(interp, "RRD Error: ",
553 rrd_get_error(), (char *) NULL);
563 static int Rrd_Resize(
564 ClientData clientData,
567 CONST84 char *argv[])
571 argv2 = getopt_init(argc, argv);
572 rrd_resize(argc, argv2);
573 getopt_cleanup(argc, argv2);
575 if (rrd_test_error()) {
576 Tcl_AppendResult(interp, "RRD Error: ",
577 rrd_get_error(), (char *) NULL);
587 static int Rrd_Restore(
588 ClientData clientData,
591 CONST84 char *argv[])
595 argv2 = getopt_init(argc, argv);
596 rrd_restore(argc, argv2);
597 getopt_cleanup(argc, argv2);
599 if (rrd_test_error()) {
600 Tcl_AppendResult(interp, "RRD Error: ",
601 rrd_get_error(), (char *) NULL);
612 * The following structure defines the commands in the Rrd extension.
616 char *name; /* Name of the command. */
617 Tcl_CmdProc *proc; /* Procedure for command. */
618 int hide; /* Hide if safe interpreter */
621 static CmdInfo rrdCmds[] = {
622 {"Rrd::create", Rrd_Create, 1}, /* Thread-safe version */
623 {"Rrd::dump", Rrd_Dump, 0}, /* Thread-safe version */
624 {"Rrd::last", Rrd_Last, 0}, /* Thread-safe version */
625 {"Rrd::lastupdate", Rrd_Lastupdate, 0}, /* Thread-safe version */
626 {"Rrd::update", Rrd_Update, 1}, /* Thread-safe version */
627 {"Rrd::fetch", Rrd_Fetch, 0},
628 {"Rrd::graph", Rrd_Graph, 1}, /* Due to RRD's API, a safe
629 interpreter cannot create
630 a graph since it writes to
631 a filename supplied by the
633 {"Rrd::tune", Rrd_Tune, 1},
634 {"Rrd::resize", Rrd_Resize, 1},
635 {"Rrd::restore", Rrd_Restore, 1},
636 {(char *) NULL, (Tcl_CmdProc *) NULL, 0}
648 if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL)
651 if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
656 * Why a global array? In keeping with the Rrd:: namespace, why
657 * not simply create a normal variable Rrd::version and set it?
659 Tcl_SetVar2(interp, "rrd", "version", VERSION, TCL_GLOBAL_ONLY);
661 for (cmdInfoPtr = rrdCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
663 * Check if the command already exists and return an error
664 * to ensure we detect name clashes while loading the Rrd
667 if (Tcl_GetCommandInfo(interp, cmdInfoPtr->name, &info)) {
668 Tcl_AppendResult(interp, "command \"", cmdInfoPtr->name,
669 "\" already exists", (char *) NULL);
672 if (safe && cmdInfoPtr->hide) {
675 * Turns out the one cannot hide a command in a namespace
676 * due to a limitation of Tcl, one can only hide global
677 * commands. Thus, if we created the commands without
678 * the Rrd:: namespace in a safe interpreter, then the
679 * "unsafe" commands could be hidden -- which would allow
680 * an owning interpreter either un-hiding them or doing
681 * an "interp invokehidden". If the Rrd:: namespace is
682 * used, then it's still possible for the owning interpreter
683 * to fake out the missing commands:
685 * # Make all Rrd::* commands available in master interperter
686 * package require Rrd
687 * set safe [interp create -safe]
688 * # Make safe Rrd::* commands available in safe interperter
689 * interp invokehidden $safe -global load ./tclrrd1.2.11.so
690 * # Provide the safe interpreter with the missing commands
691 * $safe alias Rrd::update do_update $safe
692 * proc do_update {which_interp $args} {
693 * # Do some checking maybe...
695 * return [eval Rrd::update $args]
698 * Our solution for now is to just not create the "unsafe"
699 * commands in a safe interpreter.
701 if (Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name) !=
706 Tcl_CreateCommand(interp, cmdInfoPtr->name, cmdInfoPtr->proc,
707 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
710 if (Tcl_PkgProvide(interp, "Rrd", VERSION) != TCL_OK) {
720 return init(interp, 0);
724 * See the comments above and note how few commands are considered "safe"...
725 * Using rrdtool in a safe interpreter has very limited functionality. It's
726 * tempting to just return TCL_ERROR and forget about it.
731 return init(interp, 1);