dynalog0.1/0040755000175200017560000000000007306140335013177 5ustar stephensstephengdynalog0.1/src/0040755000175200017560000000000007306140334013765 5ustar stephensstephengdynalog0.1/src/dynalog/0040755000175200017560000000000007306140334015422 5ustar stephensstephengdynalog0.1/src/dynalog/CVS/0040755000175200017560000000000007236675451016074 5ustar stephensstephengdynalog0.1/src/dynalog/CVS/Root0100644000175200017560000000003407236675451016734 0ustar stephensstepheng:local://cvs/ioncvs/cvsroot dynalog0.1/src/dynalog/CVS/Repository0100644000175200017560000000002507236675451020170 0ustar stephensstephenghome/ion/src/dynalog dynalog0.1/src/dynalog/CVS/Entries0100644000175200017560000000031207236675451017421 0ustar stephensstepheng/PKG/1.1/Sun Sep 12 02:05:38 1999// /README/1.2/Wed Oct 13 17:10:29 1999// /cli.c/1.1/Tue Sep 14 04:55:48 1999// /dynalog.h/1.1/Tue Sep 14 04:55:49 1999// /fd.c/1.2/Sun Dec 26 20:08:46 1999// D/tcl//// dynalog0.1/src/dynalog/PKG0100644000175200017560000000033006766605162015775 0ustar stephensstephengNAME=dynalog VERSION=0.1 RCS_ID="$Id: PKG,v 1.1 1999/09/12 02:05:38 stephensk Exp $" DESC="A dynamic logfile viewer." CHANGES_RELEASES="0.1" CATEGORY="Development Tools" REQUIRES_PKGS="" REQUIRES_OTHERS="tcl tk tix" dynalog0.1/src/dynalog/README0100644000175200017560000000551607001136405016302 0ustar stephensstepheng*Title: This is the Dynalog package. *Requirements Dynalog requires tcl, tk, and tix. Support for perl and C clients is available. * Introduction Dynalog is a dynamic log management system. It is a simple real-time distributed message logging system. * Components It consists of the following components: srv - the dynalog log server gui - the message viewer application cli - a raw dynalog client Applications that need to post log information (i.e. debugging information, status messages) as a messsage to a file will connect to a dynalog server. These are "log" clients. Applications that need to receive messages are also clients. The Dynalog GUI is a client that connects to a Dynalog server to register for new messages. These clients are "watch" clients. Watch clients get all messages from all log clients that are connected to the same server that match the client's watch pattern. A server can be configured to handle multiple "log domains", each client can connect to a given domain and post and receive messages. The GUI can open multiple domains and filter them. Watch filters are forwarded to the server to avoid sending unwanted messages from being sent to watch clients that do not want them. ** Message Fields A log msg contains the following fields separated by TABS: domain:application:ident:host:pid:year:time:formatted_msg date is in YYYYMMDD time is in HHMMSSss date and time are always in GMT. ** Client API The log clients are presented with a consise API to handle connections to the server. *** Tcl API proc dynalog_create {args} proc dynalog_msg {handle ident args} proc dynalog_pattern {handle pattern} proc dynalog_destroy {handle} *** C API dynalog_handle * dynalog_create(const char *option, ...) const char * dynalog_pattern(dynalog_handle *handle, const char *pattern); const char * dynalog_msg(dynalog_handle *handle, const char *ident, const char *format, ...); *** Low-level Message Structure Dynalog uses sockets for connections. All low-level messages have the following structure: \n ... The server sends a reply after a request usually this is a "ok" message. The message is formatted as a string representation of two element Tcl array. The first element is the command; the second element is the command data. [list login $type] Initializes the connection [list bye {}] Closes the connection [list get $var] Gets a variable associated with the connection [list set [list $var $val]] Sets a variable associated with the connection [list pattern $patText] Sets the current filter pattern for the connection. [list getarchive {}] Gets the filtered archive messages [list msg $logMsg] Sends a message to all watch clients connected to the domain. [list state {}]] [list eval $tclCommand] ** API Examples $Id: README,v 1.2 1999/10/13 17:10:29 stephensk Exp $ dynalog0.1/src/dynalog/cli.c0100644000175200017560000000776706767352524016373 0ustar stephensstepheng int _dynalog_enable = 1; const char *_dynalog_server_host = "localhost"; int _dynalog_server_port = 10101; static int _dynalog_fd = -2; static int _dynalog_client_connect() { if ( _dynalog_fd == -2 ) { _dynalog_fd = socket(); } } static int _dynalog_send_msg(int _fd, size_t size, const void *buf) { { unsigned char size_buf[12]; sprintf(size_buf, "%d\n", size); write(_fd, strlen(size_buf), size_buf); } { write(_fd, buf, size); } } static int _dynalog_recv_msg(int _fd, size_t size, const void *buf) { size_t r_size; { unsigned char size_buf[12]; int c, i; i = 0; while ( read(_fd, size_buf + i, 1) == 1 && ((c = (size_buf[i])) != '\n') ) { size_buf[i ++] = c; } size_buf[i] = '\0'; sscanf(size_buf, "%d\n", &r_size); } { read(_fd, buf, r_size); } return r_size; } const char *_dynalog_domain = 0; const char *_dynalog_application = 0; const char *_dynalog_host = 0; int _dynalog_pid = -1; const char *_dynalog_user = 0; const char *_dynalog_fields = 0; static void _dynalog_init_key_val(const char *key, const char *val) { switch ( tolower(key[0]) ) { case 'h': /* host */ _dynalog_host = val; break; case 'p': /* port */ _dynalog_port = atoi(val); break; case 'd': /* domain */ _dynalog_port = val; break; case 'u': /* user */ _dynalog_user = val; break; case 'e': /* enabled */ _dynalog_enabled = atoi(val); break; default: } } int _dynalog_init(int *argcp, char ***argvp, ...) { int argc = *argcp; char **argv = *argv; va_list vap; const char *key, *val; static const char *env_prefix = "DYNALOG_"; static const char *argv_prefix = "dynalog_"; int i; if ( _dynalog_fd >= 0 ) { close(_dynalog_fd); } /* scan env */ for ( i = 0; environ[i]; i ++ ) { key = argv[i]; if ( strncmp(key, env_prefix, strlen(env_prefix)) == 0 ) { key += strlen(env_prefix); if ( (val = strchr(key, '=')) ) { val ++; _dynalog_init_key_val(key, val); } } } /* scan defaults */ va_start(vap,argvp); while ( (key = va_arg(vap, const char*)) && (val = va_arg(vap, const char*)) ) { _dynalog_init_key_val(key, val); } va_end(vap); /* scan args */ for ( i = 1; i < argc; i ++ ) { key = argv[i]; if ( *key == '-' ) { key ++; if ( *key == '-' ) key ++; if ( strncmp(key, argv_prefix, strlen(argv_prefix)) == 0 ) { key += strlen(argv_prefix); if ( (val = strchr(key, '=')) ) { val ++; } else { val = argv[++ i]; } _dynalog_init_key_val(key, val); } } } return 0; } static int _dynalog_enabled_by_key(const char *key) { return 1; /* enabled */ } static char _dynalog_format_key[1024]; int _dynalog_format_begin(const char *__ident, const char *__file, int __line, const char *__func) { if ( _dynalog_pid < 0 ) { _dynalog_pid = getpid(); } if ( _dynalog_user == 0 ) { int uid = geteuid(); _dynalog_user; } #define DEF(X) (X && *X ? X : "") _dynalog_fields = "domain application host pid user ident file func line msg"; sprintf(_dynalog_format_key, "%s\t%s\t%s\t%d\t%s\t%s\t%s\t%s\t%d", DEF(_dynalog_domain), DEF(_dynalog_application), DEF(_dynalog_host), (int) _dynalog_pid, DEF(_dynalog_user), DEF(__ident), DEF(__file), DEF(__func), (int) __line ); return _dynalog_enabled_by_key(_dynalog_format_key); } int _dynalog_formatv(const char *__format, va_list *_vap) { char buf[1024], msg[1024]; if ( _dynalog_fd < 0 ) { _dynalog_connect(); } vsprintf(buf, __format, *vap); sprintf(msg, "%s {%s\t%s}", "msg", _dynalog_format, buf); _dynalog_msg_send(_dynalog_fd, msg, strlen(msg)); _dynalog_msg_recv(_dynalog_fd, 0, 0); return 1; } int _dynalog_format(const char *__format, ...) { int result; va_list vap; va_start(vap,format); result = _dynalog_formatv(__format, &vap); va_end(vap); return result; } dynalog0.1/src/dynalog/dynalog.h0100644000175200017560000000156206767352525017252 0ustar stephensstepheng#ifndef _dynalog_dynalog_h #define _dynalog_dynalog_h extern int _dynalog_enable; extern const char *_dynalog_server_host; extern int _dynalog_server_port; extern const char *_dynalog_domain; extern const char *_dynalog_application; extern const char *_dynalog_host; extern int _dynalog_pid; extern const char *_dynalog_user; extern const char *_dynalog_function; int _dynalog_init(int *argcp, char ***argvp, ...); int _dynalog_format_begin(const char *__ident, const char *__file, int __line, const char *__func); int _dynalog_format(const char *__format, ...); #if !defined(GCC) && !defined(__FUNCTION__) #define __FUNCTION__ _dynalog_function #endif #ifdef NDYNALOG #define DYNALOG(IDENT,MSG) 0 #else #ifndef DYNALOG #define DYNALOG(IDENT, MSG) (_dynalog_enable && _dynalog_format_begin(#IDENT,__FILE__,__LINE__,__FUNCTION__) && _dynalog_format MSG) #endif #endif #endif dynalog0.1/src/dynalog/fd.c0100644000175200017560000000225107031472716016163 0ustar stephensstepheng#include #include #include #include #include volatile static int io_avail = 0; static int io_fd = -1; static void (*prev_sig)(int) = 0; static void io_avail_sig(int sig, int fd) { printf("io_avail_sig(%d, %d)\n", sig, fd); if ( prev_sig != SIG_DFL && prev_sig != SIG_IGN ) { fd_set rfds, wfds, efds; struct timeval to = { 0, 0 }; int nfds, nfound; FD_ZERO(&rfds); FD_SET(io_fd, &rfds); FD_ZERO(&wfds); FD_SET(io_fd, &wfds); FD_ZERO(&efds); nfds = io_fd; printf("select()...\n"); if ( (nfound = select(nfds, rfds, wfds, efds, &to)) && FD_ISSET(io_fd, &rfds) ) { io_avail ++; } else { /* some other signal handler? */ if ( (long) prev_sig > (long) 4 ) prev_sig(sig); } } else { printf("no select()...\n"); io_avail ++; } if ( io_avail ) { printf("io_avail = %d\n", io_avail); } } int main(int argc, char **argv) { printf("%s: running...\n", argv[0]); io_fd = open("/dev/tty", O_RDONLY); prev_sig = signal(SIGIO, io_avail_sig); // prev_sig = 2; fcntl(io_fd, F_SETFL, FASYNC); while ( ! io_avail ) ; return 0; } dynalog0.1/src/dynalog/tcl/0040755000175200017560000000000007236675451016223 5ustar stephensstephengdynalog0.1/src/dynalog/tcl/CVS/0040755000175200017560000000000007236675451016656 5ustar stephensstephengdynalog0.1/src/dynalog/tcl/CVS/Root0100644000175200017560000000003407236675451017516 0ustar stephensstepheng:local://cvs/ioncvs/cvsroot dynalog0.1/src/dynalog/tcl/CVS/Repository0100644000175200017560000000003107236675451020747 0ustar stephensstephenghome/ion/src/dynalog/tcl dynalog0.1/src/dynalog/tcl/CVS/Entries0100644000175200017560000000053707236675451020214 0ustar stephensstepheng/cli/1.2/Wed Oct 13 17:10:29 1999// /cli.tcl/1.2/Wed Oct 13 17:10:29 1999// /com.tcl/1.1/Sun Sep 12 02:05:41 1999// /gui/1.1/Sun Sep 12 02:05:43 1999// /gui.tcl/1.3/Wed Oct 13 17:10:30 1999// /pat.tcl/1.1/Sun Sep 12 02:05:45 1999// /srv/1.1/Sun Sep 12 02:05:46 1999// /srv.tcl/1.2/Wed Oct 13 17:10:30 1999// /util.tcl/1.2/Wed Oct 13 17:10:30 1999// D dynalog0.1/src/dynalog/tcl/cli0100644000175200017560000000040307001136405016664 0ustar stephensstepheng#!/bin/sh #\ exec wish "$0" "$@" source cli.tcl #ctest set cli [dynalog:cli:create -type msg] while {[gets stdin m]>=0} { regexp "^\[^ \t\]+" $m cmd regsub "^\[^ \t\]+\[ \t\]?" $m {} m puts [dynalog:cli:msg $cli $cmd $m] } dynalog:cli:destroy $cli dynalog0.1/src/dynalog/tcl/cli.tcl0100644000175200017560000000515107001136405017452 0ustar stephensstepheng# $Id: cli.tcl,v 1.2 1999/10/13 17:10:29 stephensk Exp $ source util.tcl source com.tcl ############################################################################ # client init_array dc { id 0 version 1 } init_defaults dc { port 4321 host localhost domain {} application {} type query command _dummy retry 1 retry_sleep 10 } proc _dummy {id msg} { } _proc dynalog:cli:create args { global dc set id "dc[incr dc(id)]" getopts dc dc "$id," $args dynalog:cli:connect $id return $id } _proc dynalog:cli:connect {id} { global dc catch { set dc($id,sock) [socket -async $dc($id,host) $dc($id,port)] #dbg "cli:create sock = $dc($id,sock)" set dc($id,srvid) [dynalog:cli:msg $id login [list version $dc(version) type $dc($id,type) host [info hostname] pid [pid] domain $dc(domain) application $dc(application)]] switch -- $dc($id,type) { {watch} { fileevent $dc($id,sock) readable "dynalog:cli:readable $id" } } #dbg "cli:create $dc($id,type) $args => $id" } } _proc dynalog:cli:reconnect {id} { global dc catch { dynalog:com:send $dc($id,sock) {bye {}} close $dc($id,sock) dynalog:cli:connect $id } } _proc dynalog:cli:destroy {id} { global dc dynalog:com:send $dc($id,sock) {bye {}} close $dc($id,sock) unset_array dc "$id,*" } proc dynalog:cli:set {id cmd var val} { global dc set $dc($id,$var) $val } proc dynalog:cli:get {id cmd var} { global dc return $dc($id,$var) } _proc dynalog:cli:msg {id cmd msg} { global dc set val {} while {[catch { dynalog:com:send $dc($id,sock) [list $cmd $msg] set val [dynalog:com:recv $dc($id,sock)] }]} { dynalog:cli:reconnect $id } return $val } ############################################################################ # client actions _proc dynalog:cli:readable {id args} { global dc set msg [dynalog:com:recv $dc($id,sock)] if {$msg!=""} { eval [list $dc($id,command) $id $msg] } else { dynalog:cli:destroy $id } } ############################################################################ # test proc ctest {args} { global cli1 cli2 wm title . cli wm withdraw . puts [set cli1 [dynalog:cli:create -type query]] puts [set cli2 [dynalog:cli:create -type query]] dynalog:cli:msg $cli1 msg msg2 dynalog:cli:msg $cli2 msg msg2 foreach m $args { dynalog:cli:msg $cli1 msg $msg dynalog:cli:msg $cli2 msg $msg } dynalog:cli:destroy $cli1 dynalog:cli:destroy $cli2 } ############################################################################ # EOF dynalog0.1/src/dynalog/tcl/com.tcl0100644000175200017560000000132406766605165017504 0ustar stephensstepheng############################################################################ # communication proc dynalog:com:send {sock msg} { #dbg "send $sock msg [string length $msg] bytes {$msg}" puts $sock [string length $msg] puts -nonewline $sock $msg # socket might be closed before flush catch {flush $sock} #update } proc dynalog:com:recv {sock} { set msg {} catch { #gets $sock msg #dbg "recv msg length" gets $sock lmsg set lmsg [string trim $lmsg] #dbg "recv msg length $lmsg" set msg [read $sock $lmsg] } #dbg "recv $sock msg [string length $msg] bytes {$msg}" #update return $msg } ############################################################################ # EOF dynalog0.1/src/dynalog/tcl/gui0100644000175200017560000000046606766605167016741 0ustar stephensstepheng#!/bin/sh #\ exec tixwish "$0" "$@" source gui.tcl ############################################################################# tix configure -fontset 12Point #set menu [makeMenu {}] wm withdraw . if { [llength $argv] == 0 } { openFile //localhost } else { foreach f $argv { openFile $f } } dynalog0.1/src/dynalog/tcl/gui.tcl0100644000175200017560000001727507001136406017502 0ustar stephensstepheng# $Id: gui.tcl,v 1.3 1999/10/13 17:10:30 stephensk Exp $ ############################################################################# source cli.tcl source pat.tcl ############################################################################# resource about { This program can match multiple regexpression against a file The top view contains the regular expressions. The bottom view contains the lines matched. Prefixes: '!' invert the pattern. Examples: '!foobar' will not show lines that do not match 'foobar' '-apply" will show lines that match '-apply' } init_array gui {id 0} init_defaults gui {fs "\t"} ########################################################################### proc appendMsgRaw {w m} { global gui $gui($w,w:msg) insert end $m } proc appendMsg {w m} { if {[matchMsg $m]} { appendMsgRaw $w $m return 1 } else { return 0 } } ########################################################################## _proc fillMsgViewFromFile {w file} { set count 0 catch { set f [open $file] while {[gets $f m]>=0} { # tr '\t' ' ' regsub "\t" $m { } m incr count [appendMsg $w $m] } close $f } #puts "fillMsgView: count $count" } ########################################################################## # Called when gui changes pattern _proc srvGetArchive {w} { global gui set id $gui($w,w:srv) foreach m [dynalog:cli:msg $id getarchive {}] { appendMsg $w $m } } # Call back from dynalog:cli:create _proc srvMsg {id m} { global gui set w $gui($id,s:win) # handle log msgs set cmd [lindex $m 0] set msg [lindex $m 1] if {$cmd=="msg"} { appendMsgRaw $w $msg $gui($w,w:msg) see end } } # Called when gui changes pattern _proc srvMatch {w expr} { global gui set id $gui($w,w:srv) dynalog:cli:msg $id pattern $expr } ########################################################################## _proc patternsChanged {w} { global gui # Get pattern text set txt [$gui($w,w:ptrn) get 1.0 end] # Translate raw patterns into a (compiled) proc set m [matchMsgGen $txt "\t"] eval "proc matchMsg $m" srvMatch $w $txt # Fill msg view with current matches $gui($w,w:msg) delete 0 end srvGetArchive $w #fillMsgViewFromFile $w $gui($w,w:file) } ############################################################################# _proc ignoreMsg {w m} { global gui $gui($w,w:ptrn) insert end "!^$m\n" } _proc ignoreSelectedMsg {w} { global gui set x $gui($w,w:msg) foreach mi [$x curselection] { set p [$x get $mi] ignoreMsg $w $p } } ############################################################################# _proc viewServer {w} { global gui set id $gui($w,w:srv) foreach x [dynalog:cli:msg $id state {*}] { set k [lindex $x 0] set v [lindex $x 1] set items($k) $v } } ############################################################################# catch { set LogFont [font create ExprFont -family courer -size 10] } _proc destroyDynalog {w} { global gui catch { set f $gui($w,w:file) unset gui($w,w:file) gui($w,w:msg) gui($w,w:ptrn) gui($f,f:w) destroy $w } } _proc makeDynalog {w f} { global LogFont gui set gui($f,f:w) $w set gui($w,w:fs) $gui(fs) set gui($w,w:file) $f set gui($w,w:pattern) Untitled set srv [dynalog:cli:create -type watch -command "srvMsg"] set gui($w,w:srv) $srv set gui($srv,s:win) $w set gui($w,w:archive) [dynalog:cli:msg $srv get archive] set f "$f/$gui($w,w:archive)" set gui($w,w:file) $f wm iconname $w $f wm title $w $f # Top level set x ${w}.top set top $x destroy $top # frame $x # The paned window tixPanedWindow $x -paneborderwidth 0 -separatorbg gray50 -width 500 pack $x -expand yes -fill both -side top set msg [$x add msg -size 200] set ptrn [$x add ptrn -size 80] bind $x "+destroyDynalog $w" # The message frame set x $msg.frame frame $x pack $x -expand yes -fill both -side top # The message filename label set x $msg.frame.name tixFileEntry $x -label "Messages: " \ -variable gui($w,w:file) \ -options { entry.width 25 label.width 10 label.underline 10 label.anchor e } pack $x -fill x -side top # The message view set x $msg.frame.listbox tixScrolledListBox $x pack $x -expand yes -fill both -side left set x [$x subwidget listbox] set gui($w,w:msg) $x # The pattern frame set x $ptrn.frame frame $x pack $x -expand yes -fill both -side bottom # The pattern name label set x $ptrn.frame.name tixFileEntry $x -label "Patterns: " \ -variable gui($w,w:pattern) \ -options { entry.width 25 label.width 10 label.underline 10 label.anchor e } pack $x -fill x -side top # The pattern view set x $ptrn.frame.text tixScrolledText $x pack $x -expand yes -fill both -side left set x [$x subwidget text] set gui($w,w:ptrn) $x bind $x "patternsChanged $w" #puts [array get dynalog] # add a menu $w configure -menu [makeMenu $w] # update patternsChanged $w return $top } ############################################################################# _proc makeMenu {w} { set x ${w}.menu set top $x destroy $x menu $x # -tearoff 0 #pack $x -expand yes -fill x -side top #-tearoff 1 -title GAUD set m $x.file $x add cascade -label "File" -menu $m -underline 0 menu $m -tearoff 1 $m add command -label "Save Configuration" $m add command -label "Save Configuration As..." $m add command -label "Close" -command "destroyDynalog $w" $m add command -label "Exit" -accelerator "Ctrl-q" -command "exit" set m $x.edit $x add cascade -label "Edit" -menu $m -underline 0 menu $m -tearoff 1 $m add command -label "Undo" $m add command -label "Cut" $m add command -label "Copy" $m add command -label "Paste" set m $x.mod $x add cascade -label "Pattern" -menu $m -underline 0 menu $m -tearoff 1 $m add command -label "Apply" -command "patternsChanged $w" -accelerator "Ctrl+a" $m add command -label "Add Ignoring Selected Msg" -command "ignoreSelectedMsg $w" $m add separator $m add command -label "New" $m add command -label "Open..." $m add command -label "Save" $m add command -label "Save As..." set m $x.view $x add cascade -label "View" -menu $m -underline 0 menu $m -tearoff 1 $m add command -label "Server Status" -command "viewServer $w" set m $x.help $x add cascade -label "Help" -menu $m -underline 0 menu $m -tearoff 1 $m add command -label "About..." #pack $x.file $x.edit $x.mod -side left #pack $x.help -side right return $top; } ############################################################################# set topi 0 _proc openFile {f args} { global gui if { [llength $args] } { set w [lindex $args 0] } else { set w ".dynalog[incr gui(id)]" } if [info exists gui($f,f:w)] { set w $gui($f,f:w) wm deiconify $w return 2 } elseif { [regexp {^//} $f] || [file readable $f] } { #puts "openFile w = {$w}, args = {$args}" catch { toplevel $w } makeDynalog $w $f return 1 } else { return 0 } } _proc openFilePrompt { } { set dialog [tix filedialog tixFileSelectDialog] $dialog config -command openFile $dialog popup } _proc openServerPrompt { } { set dialog [tix filedialog tixFileSelectDialog] $dialog config -command openFile $dialog popup } ############################################################################# # EOF dynalog0.1/src/dynalog/tcl/pat.tcl0100644000175200017560000000247606766605171017520 0ustar stephensstepheng# $Id: pat.tcl,v 1.1 1999/09/12 02:05:45 stephensk Exp $ ############################################################################# # patterns _proc textToPatterns {s fs} { set ps {} foreach p [split $s "\n"] { # check for raw expression if {![regsub {^$} $p {} p]} { #remove comments #regsub {\#.*$} $p {} p #remove leading whitespace #regsub {^[ ]+} $p {} p #remove trailing whitespace #regsub {[ ]+$} $p {} p #escape special chars regsub -all {([\\{}])} $p {\\\1} p #convert any whitespace to match any whitespace regsub -all "\[ \t\]" $p "\[ \t\]" p #convert . to non-fs regsub -all {\.} $p "\[^${fs}\]" p } if {$p != ""} { lappend ps $p } } return $ps } _proc matchMsgGen {ps fs} { set e "1" set ps [textToPatterns $ps $fs] foreach p $ps { set o " && " # logical and/or if [regsub {^&&?} $p {} p] { # } elseif [regsub {^\|\|?} $p {} p] { set o " || " } # negate match set n {} if {[regsub {^!} $p {} p]} { set n {!} } if {$p != ""} { set e "($e$o$n\[regexp -- {$p} \$m\])" } } set e "expr $e\n" set e "{m} {\n$e}" #puts " PROC = $e" return $e } ############################################################################# # EOF dynalog0.1/src/dynalog/tcl/srv0100644000175200017560000000006706766605172016760 0ustar stephensstepheng#!/bin/sh #\ exec wish "$0" "$@" source srv.tcl stest dynalog0.1/src/dynalog/tcl/srv.tcl0100644000175200017560000001270607001136406017522 0ustar stephensstepheng# $Id: srv.tcl,v 1.2 1999/10/13 17:10:30 stephensk Exp $ source util.tcl source com.tcl source pat.tcl ############################################################################ # server init_array ds { id 0 version 1 } init_defaults ds { port 4321 archive archive retry 1 retry_sleep 10 } proc dynalog:patproc {w} {return 1} _proc dynalog:srv:create {args} { global ds set id "ds[incr ds(id)]" getopts ds ds "$id," $args set sk [socket -server "dynalog:srv:cli:connect $id" $ds($id,port)] set ds($id,sk) $sk # a list of all clients set ds($id,cli) {} # a list of logging clients set ds($id,msg) {} # a list of log watch clients set ds($id,watch) {} return $id } proc dynalog:srv:destroy {id} { global ds close $ds($id,sk) unset ds($id,sk) } proc dynalog:srv:run {id} { global ds } proc dynalog:srv:set {id cmd var val} { global ds set $ds($id,$var) $val } proc dynalog:srv:get {id cmd var} { global ds return $ds($id,$var) } ############################################################################ # client side _proc dynalog:srv:cli:connect {id sk addr q} { global ds # add to client list lappend ds($id,cli) $sk # copy info from srv set ds($id,$sk,archive) $ds($id,archive) # default patproc set ds($id,$sk,patproc) dynalog:patproc fileevent $sk readable "dynalog:srv:cli:readable $id $sk" } _proc dynalog:srv:cli:destroy {id sk args} { global ds # close the socket catch { close $sk set type $ds($id,$sk,type) # remove from ds($id,$type) array set filter "expr {\$x!=\"$sk\"}" lfilter ds($id,$type) x $filter # remove $sk from ds($id,cli) array lfilter ds($id,cli) x $filter # remove $ds($id,$sk,patproc) proc if {$ds($id,$sk,patproc)!="dynalog:patproc"} { rename $ds($id,$sk,patproc) "" } # remove client data unset_array ds "$id,$sk,*" } } proc dynalog:srv:cli:set {id sk cmd var val} { global ds set $ds($id,$sk,$var) $val } proc dynalog:srv:cli:get {id sk cmd var} { global ds return $ds($id,$sk,$var) } ############################################################################ # server input _proc dynalog:srv:cli:readable {id sk} { global ds # get msg if [catch { set msg [dynalog:com:recv $sk] }] { dynalog:srv:cli:destroy $id $sk } else { if {[catch { set cmd [lindex $msg 0] set msg [lindex $msg 1] if {$cmd==""} { dynalog:srv:cli:destroy $id $sk } else { #dbg "srv:cli:readable cmd {$cmd} msg {$msg}" dynalog:srv:cli:msg:$cmd $id $sk $cmd $msg } } errStr]} { dynalog:com:send $sk [list error $errStr] } } } ############################################################################ # server msg actions _proc dynalog:srv:cli:msg:login {id sk cmd msg} { global ds # append to login type list set ds($id,$sk,login) $msg set ds($id,$sk,enabled) 1 foreach {n v} $msg { set ds($id,$sk,$n) $v } lappend ds($id,$ds($id,$sk,type)) $sk dynalog:com:send $sk "$id,$sk" } _proc dynalog:srv:cli:msg:bye {id sk cmd msg} { global ds dynalog:srv:cli:destroy $id $sk } _proc dynalog:srv:cli:msg:state {id sk cmd msg} { global ds if {$msg==""} { set msg ",$sk" } elseif {$msg=="*"} { set msg "" } else { set msg ",$msg" } set msg "$id$msg," dbg "msg = {$msg}" dbg [list dynalog:com:send $sk [list lmap [array names ds "$msg*"] x "regsub {^$msg} \$x {} x; list \$x \$ds(\$x)"]] dynalog:com:send $sk [lmap [array names ds "$msg*"] x "set y \$x; regsub {^$msg} \$x {} n; list \$n \$ds(\$y)"] } _proc dynalog:srv:cli:msg:get {id sk cmd msg} { global ds dynalog:com:send $sk $ds($id,$sk,$msg) } _proc dynalog:srv:cli:msg:set {id sk cmd msg} { global ds set var [lindex $msg 0] set val [lindex $msg 1] set $ds($id,$sk,$var) $val dynalog:com:send $sk ok } _proc dynalog:srv:cli:msg:eval {id sk cmd msg} { dynalog:com:send $sk [catch $msg] } _proc dynalog:srv:cli:msg:pattern {id sk cmd msg} { global ds dynalog:com:send $sk ok set ds($id,$sk,pattern) $msg #dbg " $sk pattern = {$msg}" set patproc "$id:dynalog:srv:cli:matchMsg" set ds($id,$sk,patproc) $patproc set patproc "proc $patproc [matchMsgGen $msg "\t"]" #dbg " $sk patproc = $patproc" eval $patproc } _proc dynalog:srv:cli:msg:getarchive {id sk cmd msg} { global ds set msgs {} catch { set f [open $ds($id,$sk,archive)] while {[gets $f m]>=0} { if {[$ds($id,$sk,patproc) $m]} { lappend msgs $m } } close $f } dynalog:com:send $sk $msgs } _proc dynalog:srv:cli:msg:msg {id sk cmd msg} { global ds dynalog:com:send $sk ok # forward to all clients of -type watch foreach w $ds($id,watch) { # make sure we're not in a feedback # filter out any messages #dbg " patproc($w) = {$ds($id,$w,patproc)}" if {[$ds($id,$w,patproc) $msg]} { #dbg " send $w {$cmd} {$msg}" dynalog:com:send $w [list $cmd $msg] } } # append to archive catch { set f [open $ds($id,$sk,archive) {+a}] puts $f $msg close $f } } ############################################################################ # test proc stest {} { global srv wm title . srv wm withdraw . catch { dynalog:srv:destroy $srv } puts [set srv [dynalog:srv:create]] #vwait foobar } ############################################################################ # EOF dynalog0.1/src/dynalog/tcl/util.tcl0100644000175200017560000000570107001136406017662 0ustar stephensstepheng# $Id: util.tcl,v 1.2 1999/10/13 17:10:30 stephensk Exp $ ############################################################################ # misc proc comment args {} ############################################################################ # debugging proc dbg {args} { puts " === [join $args { }]" #update } #proc _old_proc {n a b} { proc $n $a $b } proc _proc_begin {n a b} { set s "puts \" <<< proc $n" set s "$s \{" set c {} foreach var $a { set s "$s$c$var = \[list \$$var\]" set c {, } } set s "$s\}" set s "$s\"\n" } #proc _proc_begin {n a b} { return "" } proc _proc_body {n a b} { return " set __pbr {} set __pbc \[catch {$b} __pbr\] puts \" >>> proc $n {$a} => (\$__pbc) \[list \$__pbr\]\" return -code \$__pbc \$__pbr " } proc _proc_body {n a b} { return $b } proc __proc {n a b} { puts " +++ [list proc $n $a ...]" #puts " [_proc_body $n $a $b]" proc $n $a "[_proc_begin $n $a $b][_proc_body $n $a $b]" } proc _proc {n a b} { __proc $n $a $b } #proc proc {n a b} { _proc $n $a $b } #rename proc _old_proc #rename _proc proc ############################################################################# # resource _proc resource {name value} { global resources set resources($name) $value } _proc get_resource {name} { global resources catch { return $resources($name) } } ############################################################################ # util proc identity {x} { return $x } proc lmap {list var body} { set nlist {} upvar $var v foreach v $list { lappend nlist [uplevel $body] } return $nlist } proc lselect {list var body} { set nlist {} upvar $var v foreach v $list { if {[uplevel $body]} { lappend nlist $v } } return $nlist } proc lfilter {lvvar bv body} { uplevel "set $lv \[lselect \$$lv $bv $body\]" } proc unset_array {name pattern} { uplevel "catch \[concat unset \[lmap \[array names $name $pattern\] x {identity $name\(\$x\)}\]\]" #uplevel "parray $name" } _proc init_array {name defs} { upvar $name a foreach {n v} $defs { #puts " {$n} {$v}" set a($n) $v } #uplevel "parray $name" } ############################################################################ # getopt _proc init_defaults {name defs} { upvar $name a set a(defaults) {} foreach {n v} $defs { #puts " {$n} {$v}" set a($n) $v lappend a(defaults) $n } #uplevel "parray $name" } _proc getopts {defs name prefix alist} { upvar $defs d upvar $name a #puts "defs $defs $name" foreach n $d(defaults) { #puts " {$prefix$n} {$d($n)}" set a($prefix$n) $d($n) } #uplevel "parray $name" #puts "opts $name" foreach {opt val} $alist { if {[regsub {^--?} $opt {} opt]} { #puts " {$prefix$opt} {$val}" set a($prefix$opt) $val } else { break } } #uplevel "parray $name" } ############################################################################ # EOF dynalog0.1/src/GUM_BUILD_ROOT0100644000175200017560000000060607306140334016121 0ustar stephensstepheng# $Id: GUM_BUILD_ROOT,v 1.3 2001/04/07 10:26:24 stephens Exp $ # Build options DEBUG=YES #OPTIMIZE=NO # output root is ../gumo GUM_GENERATED_ROOT:=$(shell cd $(GUM_BUILD_ROOT)/../gumo && /bin/pwd)# # Quick install. GUM_GENERATED_LIB_DIR=$(INSTALL_DIR_LIB)# # Pick up /iimp stuff PATH:=/iimp/bin:$(PATH) INCLUDE_DIRS_GLOBAL:=$(GUM_BUILD_ROOT) /iimp/include# LIB_DIRS_GLOBAL:=/iimp/lib# dynalog0.1/README0100644000175200017560000000727507306140335014067 0ustar stephensstephengdynalog 0.1 README ============================================================================== Copyright (c) 1997-2001 Kurt A. Stephens and Ion, Inc., All Rights Reserved. http://www.acm.org/~stephensk Kurt A. Stephens and Ion, Inc. MAKE NO REPRESENTATIONS OR WARRANTIES ABOUT THE SUITABILITY OF THE SOFTWARE, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT. Kurt A. Stephens and Ion, Inc. SHALL NOT BE LIABLE FOR ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. $Id: COPYRIGHT,v 1.3 2001/04/03 18:37:16 stephens Exp $ ============================================================================== dynalog 0.1 README ============================================================================== *Title: This is the Dynalog package. *Requirements Dynalog requires tcl, tk, and tix. Support for perl and C clients is available. * Introduction Dynalog is a dynamic log management system. It is a simple real-time distributed message logging system. * Components It consists of the following components: srv - the dynalog log server gui - the message viewer application cli - a raw dynalog client Applications that need to post log information (i.e. debugging information, status messages) as a messsage to a file will connect to a dynalog server. These are "log" clients. Applications that need to receive messages are also clients. The Dynalog GUI is a client that connects to a Dynalog server to register for new messages. These clients are "watch" clients. Watch clients get all messages from all log clients that are connected to the same server that match the client's watch pattern. A server can be configured to handle multiple "log domains", each client can connect to a given domain and post and receive messages. The GUI can open multiple domains and filter them. Watch filters are forwarded to the server to avoid sending unwanted messages from being sent to watch clients that do not want them. ** Message Fields A log msg contains the following fields separated by TABS: domain:application:ident:host:pid:year:time:formatted_msg date is in YYYYMMDD time is in HHMMSSss date and time are always in GMT. ** Client API The log clients are presented with a consise API to handle connections to the server. *** Tcl API proc dynalog_create {args} proc dynalog_msg {handle ident args} proc dynalog_pattern {handle pattern} proc dynalog_destroy {handle} *** C API dynalog_handle * dynalog_create(const char *option, ...) const char * dynalog_pattern(dynalog_handle *handle, const char *pattern); const char * dynalog_msg(dynalog_handle *handle, const char *ident, const char *format, ...); *** Low-level Message Structure Dynalog uses sockets for connections. All low-level messages have the following structure: \n ... The server sends a reply after a request usually this is a "ok" message. The message is formatted as a string representation of two element Tcl array. The first element is the command; the second element is the command data. [list login $type] Initializes the connection [list bye {}] Closes the connection [list get $var] Gets a variable associated with the connection [list set [list $var $val]] Sets a variable associated with the connection [list pattern $patText] Sets the current filter pattern for the connection. [list getarchive {}] Gets the filtered archive messages [list msg $logMsg] Sends a message to all watch clients connected to the domain. [list state {}]] [list eval $tclCommand] ** API Examples $Id: README,v 1.2 1999/10/13 17:10:29 stephensk Exp $ dynalog0.1/COPYRIGHT0100644000175200017560000000113107306140334014462 0ustar stephensstephengCopyright (c) 1997-2001 Kurt A. Stephens and Ion, Inc., All Rights Reserved. http://www.acm.org/~stephensk Kurt A. Stephens and Ion, Inc. MAKE NO REPRESENTATIONS OR WARRANTIES ABOUT THE SUITABILITY OF THE SOFTWARE, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT. Kurt A. Stephens and Ion, Inc. SHALL NOT BE LIABLE FOR ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. $Id: COPYRIGHT,v 1.3 2001/04/03 18:37:16 stephens Exp $ dynalog0.1/CHANGES0100644000175200017560000000046407306140334014172 0ustar stephensstephengdynalog 0.1 CHANGES ============================================================================== ============================================================================== Changes from release '' to 'PUBLISH_dynalog0_1' ============================================================================== dynalog0.1/TOC0100644000175200017560000000551707306140335013554 0ustar stephensstephengdynalog 0.1 Table of Contents ============================================================================== dynalog0.1: total 7 drwxr-xr-x 3 stephens stepheng 1024 Jun 2 05:33 . drwxr-xr-x 3 stephens stepheng 1024 Jun 2 05:33 .. -rw-r--r-- 1 stephens stepheng 308 Jun 2 05:33 CHANGES -rw-r--r-- 1 stephens stepheng 601 Jun 2 05:33 COPYRIGHT -rw-r--r-- 1 stephens stepheng 781 Jun 2 05:33 README -rw-r--r-- 1 stephens stepheng 109 Jun 2 05:33 TOC drwxr-xr-x 3 stephens stepheng 1024 Jun 2 05:33 src dynalog0.1/src: total 4 drwxr-xr-x 3 stephens stepheng 1024 Jun 2 05:33 . drwxr-xr-x 3 stephens stepheng 1024 Jun 2 05:33 .. -rw-r--r-- 1 stephens stepheng 390 Jun 2 05:33 GUM_BUILD_ROOT drwxr-xr-x 4 stephens stepheng 1024 Jun 2 05:33 dynalog dynalog0.1/src/dynalog: total 15 drwxr-xr-x 4 stephens stepheng 1024 Jun 2 05:33 . drwxr-xr-x 3 stephens stepheng 1024 Jun 2 05:33 .. drwxr-xr-x 2 stephens stepheng 1024 Feb 2 21:29 CVS -rw-r--r-- 1 stephens stepheng 216 Sep 11 1999 PKG -rw-r--r-- 1 stephens stepheng 2894 Oct 13 1999 README -rw-r--r-- 1 stephens stepheng 4087 Sep 13 1999 cli.c -rw-r--r-- 1 stephens stepheng 882 Sep 13 1999 dynalog.h -rw-r--r-- 1 stephens stepheng 1193 Dec 26 1999 fd.c drwxr-xr-x 3 stephens stepheng 1024 Feb 2 21:29 tcl dynalog0.1/src/dynalog/CVS: total 5 drwxr-xr-x 2 stephens stepheng 1024 Feb 2 21:29 . drwxr-xr-x 4 stephens stepheng 1024 Jun 2 05:33 .. -rw-r--r-- 1 stephens stepheng 202 Feb 2 21:29 Entries -rw-r--r-- 1 stephens stepheng 21 Feb 2 21:29 Repository -rw-r--r-- 1 stephens stepheng 28 Feb 2 21:29 Root dynalog0.1/src/dynalog/tcl: total 29 drwxr-xr-x 3 stephens stepheng 1024 Feb 2 21:29 . drwxr-xr-x 4 stephens stepheng 1024 Jun 2 05:33 .. drwxr-xr-x 2 stephens stepheng 1024 Feb 2 21:29 CVS -rw-r--r-- 1 stephens stepheng 259 Oct 13 1999 cli -rw-r--r-- 1 stephens stepheng 2665 Oct 13 1999 cli.tcl -rw-r--r-- 1 stephens stepheng 724 Sep 11 1999 com.tcl -rw-r--r-- 1 stephens stepheng 310 Sep 11 1999 gui -rw-r--r-- 1 stephens stepheng 7869 Oct 13 1999 gui.tcl -rw-r--r-- 1 stephens stepheng 1342 Sep 11 1999 pat.tcl -rw-r--r-- 1 stephens stepheng 55 Sep 11 1999 srv -rw-r--r-- 1 stephens stepheng 5574 Oct 13 1999 srv.tcl -rw-r--r-- 1 stephens stepheng 3009 Oct 13 1999 util.tcl dynalog0.1/src/dynalog/tcl/CVS: total 5 drwxr-xr-x 2 stephens stepheng 1024 Feb 2 21:29 . drwxr-xr-x 3 stephens stepheng 1024 Feb 2 21:29 .. -rw-r--r-- 1 stephens stepheng 351 Feb 2 21:29 Entries -rw-r--r-- 1 stephens stepheng 25 Feb 2 21:29 Repository -rw-r--r-- 1 stephens stepheng 28 Feb 2 21:29 Root