 |
 Issue_05_Tk |
Last update 1999/02/20
TPJ: Issue_05_Tk
This is a collection of programs published by The Perl Journal. You can download all source-code also from TPJ: Programs.
Download Filesystem.pm
package Filesystem; # Class "Filesystem": constructor, methods, destructor, global class d\ ata, # etcetera. Because a Filesystem object is a composite widget all the\ # Composite base class methods and advertised widgets are available to\ you. require 5.002; use English; use Tk; use strict; use Tk::Frame; @Filesystem::ISA = qw(Tk::Frame); Construct Tk::Widget 'Filesystem'; # Filesystem Data Structures # # %OBJTABLE # # A hash indexed by Filesystem object name. Each obje\ ct entry # is itself an implicit reference to yet another hash (a\ Tk # composite Filesystem object) with the following keys: # # {'error'} = 1 IFF `df' error line # {'stale_count'} = log file no-show count # # Filesystem Static Methods # # Filesystem->delete_stale_objects(@active_objects); # # The `delete_stale_objects' method removes Filesystem\ objects # who are missing from the MONDS "pretty print" log and \ have # exceeded the $MAXIMUM_STALE_COUNT. # # @active_objects = list of object names of currently\ active # Filesystem objects # # Filesystem->find_object($objname); # # The `find_object' method returns an object reference # corresponding to an object name. # # $objname = name of Filesystem object, typically of t\ he form # "host/fs". # # Filesystem Virtual Methods # # $objref = $mw->Filesystem(-object_name => $objname, -e\ rror => $error); # # This is the Filesystem constructor. # # $objname = object name # $error = 1 IFF this is a `df' error widget # # $objref->update_widget($text, $used, $color); # # The `update_widget' method configures a Filesystem w\ idget to # reflect the latest `df' date/time stamp and percent-us\ ed value # by changing the value of the Entry and Button widgets.\ Also, # the Frame widget that acts as the bar graph is colored\ and # lengthened or shortened as required. # # $text = date/time stamp # $used = percent used # $color = bar graph color # Initialize global variables. my $MAXIMUM_STALE_COUNT = 2; # max log file no-show count %Filesystem::OBJTABLE = (); # list of Filesystem objects # Public methods. sub delete_stale_objects { # Compare the Active Objects list with the list of all objects and\ remove # old objects that aren't active anymore. By remove we mean: dest\ roy the # composite Tk widget and delete the object table hash entry. my($class, @active_objs) = @ARG; my($objname, $found, $actobj); foreach $objname (keys %Filesystem::OBJTABLE) { $found = 0; foreach $actobj (@active_objs) { if ($actobj == $Filesystem::OBJTABLE{$objname}) { $found = 1; last; # active object } } # forend all objects if (not $found and $Filesystem::OBJTABLE{$objname}->{'stale\ _count'}++ >= $MAXIMUM_STALE_COUNT) { my $stale = $Filesystem::OBJTABLE{$objname}; $Filesystem::OBJTABLE{$objname}->destroy; delete $Filesystem::OBJTABLE{$objname}; } elsif ($found) { $Filesystem::OBJTABLE{$objname}->{'stale_count'} = 0; } } # forend all active objects } # end delete_stale_objects sub find_object { # Map an object name to an object reference via %OBJTABLE. my($class, $objname) = @ARG; return $Filesystem::OBJTABLE{$objname}; } # end find_object sub Populate { # Filesystem composite widget constructor. If $error we have a `d\ f' # error message and so construct a slightly different widget. my($cw, $args) = @ARG; $cw->SUPER::Populate($args); my($objname, $error) = (delete $args->{-object_name}, delete $args->{-error}); $args->{-borderwidth} = 0; my $ent = $cw->Component( 'Entry' => 'entry', -relief => 'sunken', -borderwidth => 1, -font => 'fixed', -width => ($error ? 60 : 15), ); $ent->pack(-side => 'left'); if (not $error) { my $but = $cw->Component( 'Button' => 'button', -font => 'fixed', -width => 4, -relief => 'flat', -disabledforeground => 'black', -state => 'disabled', -pady => 1, ); $but->pack(-side => 'left'); my $bar = $cw->Component('Frame' => 'bar', -height =>\ 8); $bar->pack(-side => 'left'); } $cw->{'error'} = $error; $cw->{'stale_count'} = 0; $Filesystem::OBJTABLE{$objname} = $cw; return $cw; } # end Populate, Filesystem constructor sub update_widget { # Update the Entry widget with new host/filesystem/date/time infor\ mation, # the Button with percentage full and lengthen or shorten the colo\ red # Frame as required. my($objref, $text, $width, $color) = @ARG; my $e = $objref->Subwidget('entry'); $e->configure(-state => 'normal'); $e->delete(0, 'end'); $e->insert(0, $text); $e->configure(-state => 'disabled'); if (not $objref->{'error'}) { $objref->Subwidget('button')->configure(-text => "$wi\ dth%"); $objref->Subwidget('bar')->configure( -width => ($width - 89) * 20 - 14, -background => $color, ); } } # end update_widget 1;
Download inied.pl
# This file initializes all Evaluate Parameters data for # monitor_disk_space and all embedded command processors. ### `monitor_disk_space' ### package main; $PDT = <<'end_of_PDT'; PDT monitor_disk_space, monds hosts, ho: list of string = 'Turkey.CC.Lehigh.EDU' poll_interval, pi: integer = 60000 exclude_filesystem_configuration_file, efcf: file = /dev/null PDTEND no_file_list end_of_PDT $MM = <<'end_of_MM'; monitor_disk_space, monds A TCP client/server to monitor disk space and alert operators when a machine is running low. Each machine runs the server monitor_disk_space_daemon which transmits a `df' output when requested by this client. Example: monds -host dandy -host dillon -host turkey .hosts A list of hosts whose disk space you want monitored. Mutliple -hosts parameters can be specified. .poll_interval Millisecond interval between `df' polls. .exclude_filesystem_configuration_file The pathname of the configuration file containing EXCLUDE_FILESYTEMS commands which describe those machine/filesystem pairs you do not want monitored. (This file can be updated on-the-fly.) end_of_MM @PDT = split( /\n/, $PDT ); @MM = split( /\n/, $MM ); ### `exclude_filesystems' ### package exclude_filesystems_pkg; $PDT = <<'end_of_PDT'; PDT exclude_filesystems, excf host, ho: string = $required filesystem, f: list of file PDTEND no_file_list end_of_PDT $MM = <<'end_of_MM'; exclude_filesystems, excf Specify filesystems we don't want to monitor. .host The IP name of a host. If the special host name ALL_HOSTS is specified then the list of excluded filesystems applies to all monitored hosts. .filesystem Specifies a list of filesystems to ignore. end_of_MM @PDT=split(/\n/, $PDT); @MM=split(/\n/, $MM); package main; 1;
monds.xbm
monds.xpm
Download monds_client
#!/usr/local/bin/perl # # monitor_disk_space_client - request `df' data from monitor_disk_spac\ e_daemon # and feed to monitor_disk_space. SOL, 97/01/13. require 5.002; use English; use IO; use strict; do {print "Usage: monds_client host port\n"; exit} if scalar @ARGV !=\ 2; STDOUT->autoflush(1); # always flush output buffer sub timeout {$SIG{ALRM} = \&timeout; print "Socket Timeout\n"} # Read socket data into a list until END_OF_DF detected; only then out\ put # to our parent's pipe. This will ensure that the parent will never b\ lock # reading input data since select() won't know we have data for our pa\ rent # until we actually do. Cycle after we receive the ACK from monds. while (1) { my $sock = IO::Socket::INET->new(PeerAddr => $ARGV[0], Proto\ => 'tcp', PeerPort => "monds($ARGV[1])")\ ; if ($sock) { my(@sd) = (); $SIG{ALRM} = \&timeout; # prevent infamous "Alarm clock\ " problem alarm 60; while(<$sock>) { push @sd, $ARG; last if /^END_OF_DF$/; } alarm 0; print ((/^END_OF_DF$/ and $#sd > 0) ? @sd : "Daemon Failure\ \n"); } else { print "Cannot Connect\n"; } $_ = <STDIN>; # wait for go-ahead from monito\ r_disk_space }
Download monds_daemon
#!/usr/local/bin/perl -w # # monitor_disk_space_daemon - transmit a `df' output to the asynchrono\ us # TCP/IP task spun-off by monitor_disk_space. SOL, 97/01/05. print `df 2>&1`; print "END_OF_DF\n";
monds_moon0.xbm
monds_moon1.xbm
Download Getopt
Download Xdefaults
monds*foreground : darkorchid monds*background : lavender monds*activeForeground : darkviolet monds*activeBackground : thistle monds*troughColor : lavender monds*highlightThickness : 0
Download go
#!/bin/sh # # Start monitor_disk_space. EF_PATH=./misc/monds_ef.cfg HN=`hostname` if [ $HN = 'Dandy.Lidie.Lehigh.EDU' ]; then MONDS_BASE=/home/bug/monds HOSTS="-host dandy -host dillon -host turkey" else MONDS_BASE=/home/lusol/lusol/monds HOSTS="-host cs1 -host turkey -host dillon" fi echo Starting monds ... cd $MONDS_BASE ./monds $HOSTS -pi 5000 -efcf $EF_PATH &
monds_ef.cfg
Download mvtar
#!/bin/sh cd /home/bug echo tarring ... tar -cf monds.tar monds rm -fr monds.tar.gz echo zipping ... gzip monds.tar hostname; ls -al monds.tar.gz rcp monds.tar.gz dillon:/home/bug/monds.tar.gz-from-dandy rsh dillon 'hostname; ls -al monds.tar.gz-from-dandy'
sample_inetd.conf
Download sample_services
monds 10346/tcp # monitor disk space
Download start_monds
#!/bin/sh # # Start monitor_disk_space. EF_PATH=./misc/monds_ef.cfg HN=`hostname` if [ $HN = 'Dandy.Lidie.Lehigh.EDU' ]; then MONDS_BASE=/home/bug/monds HOSTS="-host dandy -host dillon -host turkey" else MONDS_BASE=/home/lusol/lusol/monds HOSTS="-host cs1 -host turkey -host dillon" fi echo Starting monds ... cd $MONDS_BASE ./monds $HOSTS -pi 5000 -efcf $EF_PATH &
Download monds
#!/usr/local/bin/perl # # Minimal monitor_disk_space # # Copyright 1992 - 1997 Stephen O. Lidie. All rights reserved. # # This program is free software; you can redistribute it and/or modify\ it under # the same terms as Perl itself. # # A TCP client/server to monitor disk space and alert operators when a\ machine # is running low. Each monitored machine runs the server # `monitor_disk_space_daemon' which transmits a `df' output when reque\ sted by # this client. Results are summarized and displayed as a colored bar \ graph. # # Typically `monitor_disk_space' (monds) is used in a central computin\ g site # where a small number of critical servers must remain operational. # # monds maintains a memory-resident database containing historical dis\ k space # usage information as an associative array indexed by hostname, which\ is used # to see how filesystem usage varies in time. # # Use monitor_disk_space -full_help for full help. require 5.002; # need Perl at least at this lev\ el use English; # legible variable names use strict; # be a pure as possible # A BEGIN constructor is executed as soon as it's defined, so we # prepend the directory name that contains our own class modules and # `require' files to Perl's @INC variable so they can be located. # # Multiple BEGINs are executed in order, so once Perl knows where to f\ ind # our private code we can: # # - Do command line parsing first so we don't have to load all of # X/Tk just for a -help request. # - Create the Perl/Tk MainWindow immediately and do Tk stuff. Since\ monds # takes some time to load, a status display consisting of two Label\ # widgets keeps us occupied by displaying how initialization is # progressing. The first label is an unchanging string while the s\ econd # dynamically displays our state. sub update_status; my $LIBDIR; # pathname of monds auxiliary files\ directory my $MW; # Tk Main Window my $FS; # master grid frame for filesys\ tems my $STATUS; # label widgets for monitoring the \ monds ... my $STATUS_L; # ... initialization status my $VERSION; # monds version number use vars qw(@PDT @MM %OPT); # command line information BEGIN { $LIBDIR = "./lib"; unshift @INC, $LIBDIR; } BEGIN { use Getopt::EvaP; # Evaluate Parameters require "inied.pl"; # initialize Evaluate Parameter\ s data EvaP \@PDT, \@MM, \%OPT; # evaluate command line parameters $Getopt::EvaP::evap_embed = 1; # make Evaluate Parameters embeddab\ le now use Tk; # define Tk objects and methods $VERSION = '0.1'; $MW = MainWindow->new; $MW->positionfrom('user'); $MW->geometry('+100+100'); $MW->title("Monitor Disk Space $VERSION"); $MW->iconname('monds'); $MW->iconbitmap("\@$LIBDIR/monds.xbm"); $STATUS_L = $MW->Label(-text => 'Initializing', -fg => 'b\ lue'); $STATUS_L->grid(-row => 0, -column => 0, -sticky => 'w\ '); $STATUS = $MW->Label(qw(-width 40 -anchor w -foreground blue), -text => "monds $VERSION ..."); $STATUS->grid(-row => 0, -column => 1, -sticky => 'w')\ ; $MW->update; } update_status 'Class Modules'; use Carp; # better traceback use Tk::Dialog; # Dialog objects use Tk::ErrorDialog; # errordialog object use FileHandle; # handle methods use Filesystem; # Filesystem objects update_status 'Require Files'; require "ctime.pl"; # time conversion routines use Socket; # socket.h defines require "stat.pl"; # file status ordinals $::ST_MTIME = $::ST_MTIME; # suppress -w message update_status 'Forward Declarations'; use subs qw(abort analyze_df_data check_configuration_files construct_main_widgets display_poll_results end_monds flas\ h_widget heuristics_say_so initialize op_msg output poll_clients re\ ad_efcf start_tcp_clients stop_tcp_clients write_log_file); my %CHILD; # asynchronous process information my @COLORS; # highlight different severity leve\ ls my $DDA; # monds About dialog my %EXCLUDE; # lists of directories not to moni\ tior my @FS_ATTENTION_DATA; # list of output lines with aler\ t information my %HOSTS; # lists of `df' samples for monitore\ d hosts my $LAST_EF_MTIME; # last modification time of exclude_\ FS file my $MAX_DF_SAMPLES; # keep this many `df's samples per \ host my $OLD_TIME; # time of moon's last phase chang\ e my @PATTERNS; # list of moon phase change bitma\ ps my $PATTERN_MODULUS; # phase change counter my $PORT; # TCP port used by monds client/serve\ r tasks my $READ_BITS; # select() socket read bitmap ma\ sk my %SEVERITY; # hash of filesystem severity lev\ el cutoffs my $THROB; # label widget with throbbing moon # Main. initialize; # preset monitor_disk_space $MW->repeat($OPT{poll_interval}, \&poll_clients); # asynchronous TC\ P/IP polling MainLoop; # process Perl/Tk X events sub abort { # Special `die' so we zap kids and don't trash Tk data structures. my($msg) = @ARG; carp "monds: $msg failed: $OS_ERROR"; end_monds; } # end abort sub analyze_df_data { # Analyze the returned `df' data now: # # - Maintain the list of running samples for later (simple) heuris\ tics. # - If load-leveling is enabled for this host/filesystem and the # percentage used exceeds the threshold then initiate load-level\ ing. # - Classify which severity level the filesystem belongs in and up\ date the # %alerts hash, if required. my($fs_data_ref, $alerts_ref, $them) = @ARG; # Append new `df' samples to end of filesystem list. my(@sample_list) = split /%/, $HOSTS{$them} if defined $HOSTS{$the\ m}; my $sample_count = @sample_list; shift @sample_list if $sample_count >= $MAX_DF_SAMPLES; push @sample_list, join(':', @$fs_data_ref); $HOSTS{$them} = join '%', @sample_list; my($fs, $filesystem, $used, $llfs, $cushion, $cushion_fs, $severit\ y_level); PROCESS_DF_SAMPLES: foreach $fs (@$fs_data_ref) { ($filesystem, $used) = ($fs =~ /(.*)=(.*)/); # If possible, categorize this filesystem's severity level and\ add to # the %alerts hash. Remember, the value of an %alerts hash en\ try is # a reference to a list. DETERMINE_SEVERITY: foreach $severity_level (reverse sort(keys %SEVERITY) ) { if ($used >= $severity_level) { push(@{$alerts_ref->{$severity_level}}, sprintf("%s %s %s %d%%\n", substr(&ctime(time), 0, 19), $them, $filesystem, $us\ ed)) if heuristics_say_so $severity_level, $filesystem, $\ used, $sample_count, @sample_list; last DETERMINE_SEVERITY; } # ifend } # forend DETERMINE_SEVERITY } # forend PROCESS_DF_SAMPLES } # end analyze_df_data sub check_configuration_files { # Re-read any configuration files that may have been updated on-th\ e-fly. my $mtime = (stat $OPT{exclude_filesystem_configuration_file}) [$::ST_MTIME]; read_efcf if $mtime != $LAST_EF_MTIME; $LAST_EF_MTIME = $mtime; } # end check_configuration_files sub construct_main_widgets { # Main window with pull-down menus, a flasher and bar graphs (dyna\ mically # created/destroyed Filesystem objects). We have three grid maste\ rs: the # menubar frame, the filesystems frame and the percentage frame. update_status 'Main Widgets: menus'; $MW->option('add', '*highlightThickness' => 0); my $mb = $MW->Frame(qw(-relief raised -borderwidth 1)); my $mbf = $mb->Menubutton(qw(-text File -relief raised -bd 1)); $mbf->command(-label => 'Close', -command => [$MW => '\ iconify']); $mbf->separator; $mbf->command(-label => 'Quit', -command => \&end_monds); my $mbh = $mb->Menubutton(qw(-text Help -relief raised -bd 1)); $mbh->command(-label => 'About'); update_status 'Main Widgets: moon'; $THROB = $mb->Label( -bitmap => "\@${LIBDIR}/$PATTERNS[$PATTERN_MODULUS % 2]", ); $FS = $MW->Frame; # Filesystem grid master my $percentage = $MW->Label(-relief => 'ridge', -text => ' 90 92 \ ' . '94 96 98 100'); # Global dialogs. update_status 'Main Widgets: dialogs'; $DDA = $MW->Dialog(-title => 'About monds'); $mbh->entryconfigure('About', -command => [$DDA => 'Show'\ ]); $DDA->configure( -wraplength => '5i', -text => "Monitor Disk Space $VERSION. 97/01/05\n\\ nExamine " . "the log file and display bar graphs of filesys\ tems " . "close to capacity. The percentage full is " . "indicated by the scale at the bottom of the " \ . "display and the color of the bar. The flashin\ g " . "moon rotates 180 degrees everytime the log fil\ e " . "is updated, typically once a minute.\n\nThe en\ try " . "widgets containing textual information can be \ " . "scrolled by holding down button 2 on the point\ ing " . "device.\n\nSometimes important operator messag\ es " . "could appear.\n\nYell for an analyst when you \ " . "start seeing red.", ); update_status 'Main Widgets: heartbeat'; flash_widget $THROB, -background, 'azure', ($THROB->configure(-background))[4], 1000; if ($MW->depth > 1) { my $pixmap = $MW->Pixmap('-file' => "$LIBDIR/monds.xpm")\ ; $MW->Icon(-image => $pixmap); } # Kill status widgets and realize the main monds display. $STATUS_L->destroy; $STATUS->destroy; $mb->grid(-sticky => 'ew'); # menubar grid master $mbf->grid(-row => 0, -column => 0); $THROB->grid(-row => 0, -column => 1); $mb->gridColumnconfigure(1, -weight => 1); $mbh->grid(-row => 0, -column => 2); $FS->grid; # filesystems grid master $percentage->grid; # percentage grid master } # end construct_main_widgets sub display_poll_results { # Parse the @FS_ATTENTION_DATA list, derived from the monds log fi\ le, and # create a dynamic, graphical display of disk space utilization. \ Using # this list we: # # - Alter the phase of the moon. # - Create new Filesystem objects. # - Update date/time stamp, percent utilization and bar graphs of # Filesystem objects. # - Destroy Filesystem objects. my($line, $fsr); my(@active_Filesystem_objects) = (); my $check_time = 1; foreach $line (@FS_ATTENTION_DATA) { chomp $line; my($d1, $d2, $d3, $d4, $host, $fs, $pc) = split ' ', $line; if ($check_time) { # rotate the moon if new `df' data h\ as arrived $check_time = 0; if ($OLD_TIME ne "$d1$d2$d3$d4") { $THROB->configure( -bitmap => "\@${LIBDIR}/${PATTERNS[++$PATTERN_MOD\ ULUS % 2]}", ); $OLD_TIME = "$d1$d2$d3$d4"; } } # ifend check_time my $error = ($pc =~ /(\d+)%/) ? 0 : 1; my $objname = "$host$fs"; if ($error) { $objname = $line; $objname =~ tr/ ./_/; $objname = substr $objname, 22; } if (not ($fsr = Filesystem->find_object($objname))) { $fsr = $MW->Filesystem(-object_name => $objname, -er\ ror => $error); $fsr->grid(-in => $FS, -sticky => 'w'); } if ($error) { # percent is not numeric, must be a `d\ f' error $fsr->update_widget($line); } else { # not an error line, but a "normal" `df' ou\ tput line ($pc) = $pc =~ /(\d+)%/; # remove % $line = "$host:$fs $d1 $d2 $d3 $d4"; $fsr->update_widget($line, $pc, $COLORS[$pc - 90]); } push @active_Filesystem_objects, $fsr; }; # forend all lines that need attention Filesystem->delete_stale_objects(@active_Filesystem_objects); } # end display_poll_results sub end_monds { # Quit, Ctrl/c or kill signal, finish up. stop_tcp_clients; $MW->destroy; } # end end_monds sub flash_widget { # Flash a widget attribute periodically. my($w, $option, $val1, $val2, $interval) = @ARG; $w->configure($option => $val1); return ($MW->after($interval, [\&flash_widget, $w, $option, $va\ l2, $val1, $interval])); } # end flash_widget sub heuristics_say_so { # try to be smart about things # The latest df sample shows a filesystem exceeding a particular s\ everity # level. If the percent used appears to be static, then don't bot\ her the # operator, who has lots of other data to look at. Only applicabl\ e if the # severity level is 'Informative'. # # EXIT: 0, FALSE, do not display; 1, TRUE, display. # my($severity_level, $filesys, $used, $sample_count, @sample_list) \ = @ARG; my $f; # filesystem name my $fs; # filesystem my $fsl; # filesystem list my $p; # precent used return 1 if $sample_count < $MAX_DF_SAMPLES; # display if too f\ ew samples return 1 unless $SEVERITY{$severity_level} eq $SEVERITY{90}; INSPECT_ALL_DF_SAMPLES: foreach $fsl (@sample_list) { # each sample of machine's filesyste\ ms INSPECT_ALL_FILESYSTEMS_IN_THIS_SAMPLE: foreach $fs (split /:/, $fsl) { ($f, $p) = split /=/, $fs; next INSPECT_ALL_FILESYSTEMS_IN_THIS_SAMPLE unless $f eq $filesys; return 1 if $p != $used; # display if %used is changing } # forend INSPECT_ALL_FILESYSTEMS_IN_THIS_SAMPLE } # forend INSPECT_ALL_DF_SAMPLES return 0; # don't dispay - %used is unchang\ ing } # end heuristics_say_so sub initialize { # preset monitor_disk_space update_status 'Global Variables'; <