From 4246c3a62ad98abc131ca46bedc35a881d779ba0 Mon Sep 17 00:00:00 2001 From: Victor Wagner Date: Fri, 24 Feb 2006 14:11:33 +0000 Subject: [PATCH] Initial re-import --- Makefile | 45 +++++++++ README | 37 +++++++ syslog.n | 286 ++++++++++++++++++++++++++++++++++++++++++++++++++++ tclsyslog.c | 204 +++++++++++++++++++++++++++++++++++++ 4 files changed, 572 insertions(+) create mode 100644 Makefile create mode 100644 README create mode 100644 syslog.n create mode 100644 tclsyslog.c diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..1ec1f84 --- /dev/null +++ b/Makefile @@ -0,0 +1,45 @@ +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} + diff --git a/README b/README new file mode 100644 index 0000000..76e411f --- /dev/null +++ b/README @@ -0,0 +1,37 @@ +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 + + + diff --git a/syslog.n b/syslog.n new file mode 100644 index 0000000..ae90ce0 --- /dev/null +++ b/syslog.n @@ -0,0 +1,286 @@ +'\" +'\" 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 diff --git a/tclsyslog.c b/tclsyslog.c new file mode 100644 index 0000000..ca97600 --- /dev/null +++ b/tclsyslog.c @@ -0,0 +1,204 @@ +/* Syslog interface for tcl + +*/ +#include +#include +#include +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 (ifacilities,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 (ilogOpened) { + 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); +} -- 2.39.2