--- /dev/null
+VERSION=1.1
+# This is root of installation tree
+PREFIX=/usr/local
+CC=gcc
+#
+# Don't forget to change if your CC is not gcc
+#
+CFLAGS=-Wall -fPIC
+LDFLAGS=-shared
+# No need to link with libtcl8.0 on ELF system. Your setup might be
+# different
+LOADLIBES=
+# This is where package would be installed
+LIBDIR=${PREFIX}/lib
+# On my Debian system this would be
+# LIBDIR=/usr/local/lib/site-tcl
+# On Debian Linux this would be
+# MANSECTION=3
+# MANSUFFIX=3tcl
+MANSECTION=n
+MANSUFFIX=n
+MANDIR=${PREFIX}/man/man${MANSECTION}
+# install program. Must be GNU install compatible. install-sh from the
+# tcl distribution is good replacement if your install is not GNU
+# compatible
+INSTALL=/usr/bin/install
+# End of configuration settings
+all: libsyslog.so.${VERSION} pkgIndex.tcl
+
+libsyslog.so.${VERSION}: tclsyslog.o
+ gcc ${LDFLAGS} -o libsyslog.so.${VERSION} -DVERSION=\"${VERSION}\" tclsyslog.o ${LOADLIBES}
+
+tclsyslog.o: tclsyslog.c
+ ${CC} ${CFLAGS} ${INCLUDES} -DVERSION=\"${VERSION}\" -c tclsyslog.c
+
+pkgIndex.tcl: libsyslog.so.${VERSION}
+ echo 'package ifneeded Syslog ${VERSION} [list tclPkgSetup $$dir Syslog ${VERSION} {{libsyslog.so.${VERSION} load {syslog}}}]' >pkgIndex.tcl
+clean:
+ -rm libsyslog.so.${VERSION} pkgIndex.tcl *~ *.o
+install:
+ ${INSTALL} -m 755 -d ${LIBDIR}/syslog
+ ${INSTALL} -m 755 -c libsyslog.so.${VERSION} ${LIBDIR}/syslog
+ ${INSTALL} -m 644 -c pkgIndex.tcl ${LIBDIR}/syslog
+ ${INSTALL} -m 644 -c syslog.n ${MANDIR}/syslog.${MANSUFFIX}
+
--- /dev/null
+I was highly surprised that TclX package, which provides a lot of
+Unix-specific functionality for Tcl doesn't provide interface to syslog.
+
+So, I've designed my own package.
+
+It is not fully TEA-compliant extension yet, becouse I haven't just
+got time for writing proper autoconf configuration, but should be fairly
+easy to configure and build by anybody who knows what syslog is and why
+to use it.
+
+This version is designed for Tcl 8.0 or below. It uses old string-based
+API and should be compatible with any Tcl version down to 7.4
+
+If you use tcl 8.1 or above go and get tclsyslog-2.0
+
+Home site of this package is at
+
+http://www.ice.ru/~vitus/works/tcl.html#syslog
+
+Installation
+
+1. Edit variables on the top of Makefile
+2. Do make all
+3. Test extension by loading it into tclsh via load ./libsyslog.so.1.1
+ and sending couple of messages from command line
+4. Verify that PREFIX variable set so that ${PREFIX}/lib is included in
+ your tcl_pkgPath (or set LIBDIR to directory in tcl_pkgPath)
+ and do make install
+ Note that GNU install is assumed. Use install-sh provided in tcl
+ distribution if your install is not GNU install
+
+Send comments, suggestions and patches to vitus@ice.ru
+
+ Victor Wagner
+
+
+
--- /dev/null
+'\"
+'\" Copyright (c) 1999 Victor B. Wagner
+'\"
+'\"
+'\" RCS: @(#) $Id: syslog.n,v 1.1 2006-02-24 14:11:33 vitus Exp $
+'\"
+'\" The definitions below are for supplemental macros used in Tcl/Tk
+'\" manual entries.
+'\"
+'\" .AP type name in/out ?indent?
+'\" Start paragraph describing an argument to a library procedure.
+'\" type is type of argument (int, etc.), in/out is either "in", "out",
+'\" or "in/out" to describe whether procedure reads or modifies arg,
+'\" and indent is equivalent to second arg of .IP (shouldn't ever be
+'\" needed; use .AS below instead)
+'\"
+'\" .AS ?type? ?name?
+'\" Give maximum sizes of arguments for setting tab stops. Type and
+'\" name are examples of largest possible arguments that will be passed
+'\" to .AP later. If args are omitted, default tab stops are used.
+'\"
+'\" .BS
+'\" Start box enclosure. From here until next .BE, everything will be
+'\" enclosed in one large box.
+'\"
+'\" .BE
+'\" End of box enclosure.
+'\"
+'\" .CS
+'\" Begin code excerpt.
+'\"
+'\" .CE
+'\" End code excerpt.
+'\"
+'\" .VS ?version? ?br?
+'\" Begin vertical sidebar, for use in marking newly-changed parts
+'\" of man pages. The first argument is ignored and used for recording
+'\" the version when the .VS was added, so that the sidebars can be
+'\" found and removed when they reach a certain age. If another argument
+'\" is present, then a line break is forced before starting the sidebar.
+'\"
+'\" .VE
+'\" End of vertical sidebar.
+'\"
+'\" .DS
+'\" Begin an indented unfilled display.
+'\"
+'\" .DE
+'\" End of indented unfilled display.
+'\"
+'\" .SO
+'\" Start of list of standard options for a Tk widget. The
+'\" options follow on successive lines, in four columns separated
+'\" by tabs.
+'\"
+'\" .SE
+'\" End of list of standard options for a Tk widget.
+'\"
+'\" .OP cmdName dbName dbClass
+'\" Start of description of a specific option. cmdName gives the
+'\" option's name as specified in the class command, dbName gives
+'\" the option's name in the option database, and dbClass gives
+'\" the option's class in the option database.
+'\"
+'\" .UL arg1 arg2
+'\" Print arg1 underlined, then print arg2 normally.
+'\"
+'\" RCS: @(#) $Id: syslog.n,v 1.1 2006-02-24 14:11:33 vitus Exp $
+'\"
+'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
+.if t .wh -1.3i ^B
+.nr ^l \n(.l
+.ad b
+'\" # Start an argument description
+.de AP
+.ie !"\\$4"" .TP \\$4
+.el \{\
+. ie !"\\$2"" .TP \\n()Cu
+. el .TP 15
+.\}
+.ta \\n()Au \\n()Bu
+.ie !"\\$3"" \{\
+\&\\$1 \\fI\\$2\\fP (\\$3)
+.\".b
+.\}
+.el \{\
+.br
+.ie !"\\$2"" \{\
+\&\\$1 \\fI\\$2\\fP
+.\}
+.el \{\
+\&\\fI\\$1\\fP
+.\}
+.\}
+..
+'\" # define tabbing values for .AP
+.de AS
+.nr )A 10n
+.if !"\\$1"" .nr )A \\w'\\$1'u+3n
+.nr )B \\n()Au+15n
+.\"
+.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
+.nr )C \\n()Bu+\\w'(in/out)'u+2n
+..
+.AS Tcl_Interp Tcl_CreateInterp in/out
+'\" # BS - start boxed text
+'\" # ^y = starting y location
+'\" # ^b = 1
+.de BS
+.br
+.mk ^y
+.nr ^b 1u
+.if n .nf
+.if n .ti 0
+.if n \l'\\n(.lu\(ul'
+.if n .fi
+..
+'\" # BE - end boxed text (draw box now)
+.de BE
+.nf
+.ti 0
+.mk ^t
+.ie n \l'\\n(^lu\(ul'
+.el \{\
+.\" Draw four-sided box normally, but don't draw top of
+.\" box if the box started on an earlier page.
+.ie !\\n(^b-1 \{\
+\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.el \}\
+\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.\}
+.fi
+.br
+.nr ^b 0
+..
+'\" # VS - start vertical sidebar
+'\" # ^Y = starting y location
+'\" # ^v = 1 (for troff; for nroff this doesn't matter)
+.de VS
+.if !"\\$2"" .br
+.mk ^Y
+.ie n 'mc \s12\(br\s0
+.el .nr ^v 1u
+..
+'\" # VE - end of vertical sidebar
+.de VE
+.ie n 'mc
+.el \{\
+.ev 2
+.nf
+.ti 0
+.mk ^t
+\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
+.sp -1
+.fi
+.ev
+.\}
+.nr ^v 0
+..
+'\" # Special macro to handle page bottom: finish off current
+'\" # box/sidebar if in box/sidebar mode, then invoked standard
+'\" # page bottom macro.
+.de ^B
+.ev 2
+'ti 0
+'nf
+.mk ^t
+.if \\n(^b \{\
+.\" Draw three-sided box if this is the box's first page,
+.\" draw two sides but no top otherwise.
+.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.\}
+.if \\n(^v \{\
+.nr ^x \\n(^tu+1v-\\n(^Yu
+\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
+.\}
+.bp
+'fi
+.ev
+.if \\n(^b \{\
+.mk ^y
+.nr ^b 2
+.\}
+.if \\n(^v \{\
+.mk ^Y
+.\}
+..
+'\" # DS - begin display
+.de DS
+.RS
+.nf
+.sp
+..
+'\" # DE - end display
+.de DE
+.fi
+.RE
+.sp
+..
+'\" # SO - start of list of standard options
+.de SO
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+.ft B
+..
+'\" # SE - end of list of standard options
+.de SE
+.fi
+.ft R
+.LP
+See the \\fBoptions\\fR manual entry for details on the standard options.
+..
+'\" # OP - start of full description for a single option
+.de OP
+.LP
+.nf
+.ta 4c
+Command-Line Name: \\fB\\$1\\fR
+Database Name: \\fB\\$2\\fR
+Database Class: \\fB\\$3\\fR
+.fi
+.IP
+..
+'\" # CS - begin code excerpt
+.de CS
+.RS
+.nf
+.ta .25i .5i .75i 1i
+..
+'\" # CE - end code excerpt
+.de CE
+.fi
+.RE
+..
+.de UL
+\\$1\l'|0\(ul'\\$2
+..
+.TH syslog n 2.0 Tcl "Tcl Syslog extension"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+syslog \- send message to syslog from Tcl script
+.SH SYNOPSIS
+\fBpackage require Syslog\fR
+
+\fBsyslog \fR?\fIoptions\fR? \fIpriority\fR \fImessage\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+This command sends \fImessage\fR to system syslog facility
+with given \fIpriority\fR. Valid priorities are:
+.PP
+\fBemerg\fR, \fBalert\fR, \fBcrit\fR, \fBerr\fR, \fBerror\fR, \fBwarning\fR, \fBnotice\fR, \fBinfo\fR, \fBdebug\fR.
+
+.PP
+By default, facility \fBuser\fR is used and value of tcl variable
+\fBargv0\fR is used as ident string.
+However, any of the following options may be
+specified before \fIpriority\fR to control these parameters:
+.TP 20
+\fB\-facility\fR \fIvalue\fR
+Use specified facility instead of \fBuser\fR. Following facility are
+recognized:
+.PP
+\fBauthpriv\fR, \fBcron\fR, \fBdaemon\fR, \fBkernel\fR, \fBlpr\fR,
+\fBmail\fR, \fBnews\fR, \fBsyslog\fR, \fBuser\fR, \fBuucp\fR, \fBlocal0\fR,
+\fBlocal1\fR, \fBlocal2\fR.
+.TP 20
+\fB\-ident\fR \fIstring\fR
+Use given \fIstring\fR instead of \fBargv0\fB variable for ident string.
+.TP 20
+\fB\-options\fR \fIinteger\fR
+Set syslog options such as \fBLOG_CONS\fR, \fBLOG_NDELAY\fR
+You should user numeric values of those from your system \fBsyslog.h\fR
+file, becouse I haven't got time to implement yet another hash table.
+.RE
+
+
+.SH KEYWORDS
+logging, syslog
--- /dev/null
+/* Syslog interface for tcl
+
+*/
+#include <tcl.h>
+#include <syslog.h>
+#include <string.h>
+typedef struct {
+ int logOpened;
+ int facility,options;
+ char ident[32];
+ Tcl_HashTable *priorities;
+ Tcl_HashTable *facilities;
+ } SyslogInfo;
+
+void Syslog_ListHash(Tcl_Interp *interp,Tcl_HashTable *table);
+/* SyslogHelp - puts usage message into interp->result
+ *
+ *
+ */
+
+void SyslogHelp(Tcl_Interp *interp,char *cmdname)
+{ Tcl_AppendResult(interp,"Wrong # of args. should be ",cmdname,
+ " ?option value? priority message",NULL);
+}
+
+/* Syslog_Log -
+ * implements syslog tcl command. General format: syslog ?options? level text
+ * options -facility -ident -options
+ *
+ */
+
+
+int Syslog_Log(ClientData data, Tcl_Interp *interp, int argc, char **argv)
+{ SyslogInfo *info=(SyslogInfo *)data;
+ char *message = NULL;
+ int priority;
+ int i=1;
+ if (argc<=1) {
+ SyslogHelp(interp,argv[0]);
+ return TCL_ERROR;
+ }
+ while (i<argc-1) {
+ if (!strcmp(argv[i],"-facility")) {
+ Tcl_HashEntry * entry=Tcl_FindHashEntry(info->facilities,argv[i+1]);
+ if (!entry) {
+ Tcl_AppendResult(interp,"Invalid facility name: \"",argv[i+1],
+ "\" available facilities:",
+ NULL);
+ Syslog_ListHash(interp,info->facilities);
+ return TCL_ERROR;
+ }
+ info->facility=(int)Tcl_GetHashValue(entry);
+ if (info-> logOpened) {
+ closelog();
+ info-> logOpened=0;
+ }
+ } else if (!strcmp(argv[i],"-options")) {
+ int tmp;
+ if (Tcl_GetInt(interp,argv[i+1],&tmp)==TCL_ERROR)
+ return TCL_ERROR;
+ info->options=tmp;
+ if (info->logOpened) {
+ closelog();
+ info->logOpened=0;
+ }
+ } else if (!strcmp(argv[i],"-ident")) {
+ strncpy(info->ident, argv[i+1],32);
+ info->ident[31]=0;
+ if (info->logOpened) {
+ closelog();
+ info->logOpened=0;
+ }
+ } else {
+ Tcl_HashEntry *entry=Tcl_FindHashEntry(info->priorities,argv[i]);
+ if (!entry) {
+ Tcl_AppendResult(interp,"Invalid syslog level \"",argv[i],
+ "\" available levels:",
+ NULL);
+ Syslog_ListHash(interp,info->priorities);
+ return TCL_ERROR;
+ }
+ priority=(int)Tcl_GetHashValue(entry);
+ message=argv[i+1];
+ i+=2;
+ if (i<argc-1) {
+ SyslogHelp(interp,argv[0]);
+ return TCL_ERROR;
+ }
+ }
+ i+=2;
+ }
+ if (i<argc-1) {
+ SyslogHelp(interp,argv[0]);
+ return TCL_ERROR;
+ }
+ if (message) {
+ if (!info->logOpened) {
+ openlog(info->ident,info->options,info->facility);
+ info->logOpened=1;
+ }
+ syslog(priority,"%s",message);
+ }
+ return TCL_OK;
+}
+/*
+ * Syslog_ListHash - appends to interp result all the values of given
+ * hash table
+ */
+void Syslog_ListHash(Tcl_Interp *interp,Tcl_HashTable *table)
+{
+ Tcl_HashSearch *searchPtr=(Tcl_HashSearch *)
+ Tcl_Alloc(sizeof(Tcl_HashSearch));
+ Tcl_HashEntry *entry;
+ char separator[3]={' ',' ',0};
+ entry=Tcl_FirstHashEntry(table,searchPtr);
+ while (entry) {
+ Tcl_AppendResult(interp,separator,Tcl_GetHashKey(table,entry),NULL);
+ separator[0]=',';
+ entry=Tcl_NextHashEntry(searchPtr);
+ }
+ Tcl_Free((char *)searchPtr);
+}
+/*
+ * Syslog_Delete - Tcl_CmdDeleteProc for syslog command.
+ * Frees all hash tables and closes log if it was opened.
+ */
+void Syslog_Delete(ClientData data)
+{ SyslogInfo *info=(SyslogInfo *)data;
+ Tcl_DeleteHashTable(info->facilities);
+ Tcl_Free((char *)info->facilities);
+ Tcl_DeleteHashTable(info->priorities);
+ Tcl_Free((char *)info->priorities);
+ if (info->logOpened) {
+ closelog();
+ }
+ Tcl_Free((char *)info);
+}
+/*
+ * My simplified wrapper for add values into hash
+ *
+ */
+void AddEntry(Tcl_HashTable *table,char *key,int value)
+{ int new;
+ Tcl_HashEntry *entry=Tcl_CreateHashEntry(table,key,&new);
+ Tcl_SetHashValue(entry,(ClientData)value);
+}
+/*
+ * Syslog_Init
+ * Package initialization procedure for Syslog package.
+ * Creates command 'syslog', fills hash tables to map symbolic prioriry
+ * and facility names to system constants.
+ */
+int Syslog_Init(Tcl_Interp *interp)
+{ char *argv0;
+ SyslogInfo *info=(SyslogInfo *)Tcl_Alloc(sizeof(SyslogInfo));
+ info->logOpened=0;
+ info->options=0;
+ info->facility=LOG_USER;
+ argv0=Tcl_GetVar(interp,"argv0",TCL_GLOBAL_ONLY);
+ if (argv0) {
+ strncpy(info->ident,argv0,32);
+ } else {
+ strcpy(info->ident,"Tcl script");
+ }
+ info->ident[31]=0;
+ info->facilities =(Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(info->facilities,TCL_STRING_KEYS);
+ AddEntry(info->facilities,"auth",LOG_AUTH);
+#ifndef LOG_AUTHPRIV
+# define LOG_AUTHPRIV LOG_AUTH
+#endif
+ AddEntry(info->facilities,"authpriv",LOG_AUTHPRIV);
+ AddEntry(info->facilities,"cron",LOG_CRON);
+ AddEntry(info->facilities,"daemon",LOG_DAEMON);
+ AddEntry(info->facilities,"kernel",LOG_KERN);
+ AddEntry(info->facilities,"lpr",LOG_LPR);
+ AddEntry(info->facilities,"mail",LOG_MAIL);
+ AddEntry(info->facilities,"news",LOG_NEWS);
+ AddEntry(info->facilities,"syslog",LOG_SYSLOG);
+ AddEntry(info->facilities,"user",LOG_USER);
+ AddEntry(info->facilities,"uucp",LOG_UUCP);
+ AddEntry(info->facilities,"local0",LOG_LOCAL0);
+ AddEntry(info->facilities,"local1",LOG_LOCAL1);
+ AddEntry(info->facilities,"local2",LOG_LOCAL2);
+ AddEntry(info->facilities,"local3",LOG_LOCAL3);
+ AddEntry(info->facilities,"local4",LOG_LOCAL4);
+ AddEntry(info->facilities,"local5",LOG_LOCAL5);
+ AddEntry(info->facilities,"local6",LOG_LOCAL6);
+ AddEntry(info->facilities,"local7",LOG_LOCAL7);
+ info->priorities = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(info->priorities,TCL_STRING_KEYS);
+ AddEntry(info->priorities,"emerg",LOG_EMERG);
+ AddEntry(info->priorities,"alert",LOG_ALERT);
+ AddEntry(info->priorities,"crit",LOG_CRIT);
+ AddEntry(info->priorities,"err",LOG_ERR);
+ AddEntry(info->priorities,"error",LOG_ERR);
+ AddEntry(info->priorities,"warning",LOG_WARNING);
+ AddEntry(info->priorities,"notice",LOG_NOTICE);
+ AddEntry(info->priorities,"info",LOG_INFO);
+ AddEntry(info->priorities,"debug",LOG_DEBUG);
+ Tcl_CreateCommand(interp,"syslog",Syslog_Log,(ClientData) info,
+ Syslog_Delete);
+ return Tcl_PkgProvide(interp,"Syslog",VERSION);
+}
projects / oss / tclsyslog.git / commitdiff