swatch-3.2.3/0000755000076500007650000000000011032472605011126 5ustar etaetaswatch-3.2.3/CHANGES0000644000076500007650000001651411032472403012124 0ustar etaeta20080507: Changed default tail command arguments Fixed input-record-separator command line argument to allow for a null string Corrected perlcode parsing and depth handling Fixed how swatch kills off the tail command on exit Fixed how the tail command is launched 20060721: Took out print statement in Threshold module that was only there for debugging purposes. 20060720: Trying submitted patch no. 1160401 so that tail will die when it is supposed to. Swatch now dies when it cannot write its watcher script instead of chewing up the CPU doing nothing. 20060713: Updated documentation. 20060622: Eliminated the default configuration since it really did not do anything useful. 20060601: Set $0 in the swatch script to the original command line so that it can be distinguished from other swatch instances in the process table. 20060502: Added "include" configuration keyword for including other configuration files into the main one. Fixed handling of variable set by --dump-script command line argument. 20060428: Can now use \ as a line continuation indicator in config file. 20060425: Created Threshold module as an intended replacement for throttle 20060309: Changed setting of SIGCHLD from IGNORE to DEFAULT. Added "normal" mode to echo action for backward compatability Removed passing of unused REGEX option to throttle Fixed setting of $RestartTime variable so that it will restart on the 1st day Fixed parsing of "perlcode 0" caused by code block being incorrectly flagged as being open. 20051201: Fixed documentation errors described in [ swatch-Patches-938132 ] Fixed dependency checking and documentation [ swatch-Patches-983344 ] Added /usr/bin/write as default command to the "write" action. [ swatch-Patches-983347 ] Fixed grammatical and typographical errors as well as an option quoting bug. [ swatch-Patches-986013 ] Fixed MAILER assignment. [ swatch-Patches-1077713 ] 20040719: Released version 3.1.1 20040701: Fixed error in default TIME_REGEX option in throttle function. Added proper signal handling to mail action so that it wont hang on UNIX OSes like FreeBSD. 20040408: Released version 3.1 20031118: Fixed extra module "use" code 20030313: Changed tail arguments from "-1 -f" to "-n 0 -f" 20030109: Put action and throttle code into modules named Swatch::Actions and Swatch::Throttle respectively. Changed "-I" command option from being shorthand for "--input-record-separator" to being short for "--extra-include-dirs" Added --extra-include-dirs (or -I) and --extra-modules (or -M) command line options. 20020712: Changed $PERL setting from 'perl' to $^X Changed interval from 1.0 to 0.5 and added maxinterval setting to File::Tail->new options. Removed commas from string of addresses passed to the mailer in mail action code. 20020429: Fixed message option assignment within and outside of throttle blocks. 20020419: Fixed yet another throttle bug that was causing it to return blank messages. Added depth setting to perlcode to allow perlcode to be placed in different levels of nested blocks. 20020412: Fixed typo in threshold code generation. 20020405: Added '-1' to default arguments for use with tail. 20020403: Added --tail-program-name and --tail-args command line options 20020402: Added "code" action so users can insert perl code in action area Added possibility for user to overide "message" option to any action. Added --awk-field-syntax and --noawk-field-syntax command line options 20020329: Moved write_pid code from the main script to the generated (watcher) script. Added "perlcode" and "threshold" Corrected various typos Allowed watchfor, ignore, throttle, threshold, and perlcode keys in config file to be case insensitive. fixed STDOUT autoflush setting. 20020319: Added option for user to use their own regular expression to extract a throttle key from a message using greedy pattern matching. 20020307: Went back to using the system's tail(1) command for tailing files. Added --use-cpan-file-tail option to users to keep using the File::Tail module for tailing files. Added testing for validity of patterns. 3.0.4: Fixed major bug involving key value assignment in throttle. 3.0.3: Simplified Makefile.PL Fixed action parsing problem where a space was being appended to the option name. Fixed action parsing problem dealing with quotation marks. Fixed documentation on the '--restart-time' command line option. 3.0.2: Changed the default input file to be /var/log/messages instead of /var/log/syslog if it exists. Fixed problem of swatch continuing to try to match a pattern after the pattern was matched but was throttled. Credit goes to Rob Davies for bringing this to my attention. Changed building of throttled messages to replace characters that are cut out with a '_' Added date_loc, time_loc, and extra_cuts options to throttle. Fixed numerous problems with throttling Changed "#!/bin/sh -" to "#!/usr/bin/perl" on first line of script. Fixed "--daemon" mode so that it runs more reliably in the background by: Cleaned up read_config routine. Fixed parsing problem involving the use of a single TAB as a separator. Added default code generation when faced with a config file that does not contain anything useful. Changed format of message displayed when throttling to include the entire message. 3.0.1: Fixed code that searches for sendmail program. 3.0: Fixed write action. Added code to search for sendmail and write programs. Fixed documentation to say that "use=message" is the default for throttle. Added --pid-file option. Removed --pattern-separator and --action-separator options from documentation. Changed record structure that holds configuration information so that it can handle multiple actions of the same type within a single watchfor block. Turned autoflush on inside of pipe action. 3.0b5: Implemented use of $n (field number variable) use in commands. Added the "keep_open" option to the "pipe" action. The pipe is now closed every time the action is used unless this option is used. Added the "use" option to throtle. 3.0b4: Removed "use strict;" from watcher script until I make the code a little cleaner. It currently prevents the "--examine" switch from working. 3.0b3: Added "continue" and "quit" actions. Changed keyword/value separation from '=' to whitespace, but will still handle the '=' sign for backward compatability. This was done in order to make the configuration file make more sense. Reverted back to creating a script file, but instead of creating it in /tmp, Swatch creates it in the user's home directory under the name .swatch_script. Fixed parsing of "throttle" setting. Added "when" option to all actions to allow for time-of-day and day-of-week specific actions. Added "subject" option to "mail" action. 3.0b2: Added signal handling. Updated POD to include the color options to the echo action. Fixed sun terminal detection bug in ring_bell subroutine. Fixed echo() subroutine to handle multiple modes. Added some color definitions for use in echo() routine. Corrected errors in example files. Fixed package checking code in Makefile.PL and added some perl version checking. swatch-3.2.3/COPYING0000644000076500007650000004312710077025676012202 0ustar etaeta GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. swatch-3.2.3/COPYRIGHT0000644000076500007650000000141310077025676012432 0ustar etaeta swatch: The Simple WATCHdog Copyright (C) 1993-2004 E. Todd Atkins This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA swatch-3.2.3/examples/0000755000076500007650000000000011032472605012744 5ustar etaetaswatch-3.2.3/examples/SendMail.pm0000644000076500007650000000220610077025676015010 0ustar etaetapackage Swatch::SendMail; require 5.000; require Exporter; use strict; use Carp; use Mail::Sendmail; use Sys::Hostname; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); @ISA = qw(Exporter); @EXPORT = qw/ &send_mail /; $VERSION = '20031118'; ################################################################ sub send_mail { my $login = (getpwuid($<))[0]; my $host = hostname; my %opts = ( 'ADDRESSES' => $login, 'FROM' => "$login\@$host", 'SUBJECT' => 'Message from Swatch', @_ ); (my $to_line = $opts{'ADDRESSES'}) =~ s/:/,/g; my %mail = ( To => $to_line, From => $opts{FROM},, Subject => $opts{SUBJECT}, Message => $opts{MESSAGE}, ); sendmail(%mail) or warn $Mail::Sendmail::error; return 0; } ################################################################ ## The POD ### =head1 NAME Swatch::SendMail - Swatch interface to the Mail::Sendmail module =head1 SYNOPSIS use Swatch::SendMail; =head1 SWATCH SYNTAX =head1 DESCRIPTION =head1 AUTHOR E. Todd Atkins, todd.atkins@stanfordalumni.org =head1 SEE ALSO perl(1), swatch(1). =cut 1; swatch-3.2.3/INSTALL0000644000076500007650000000165110077025676012174 0ustar etaetaTo install, simply issue the following commands: perl Makefile.PL make make test make install make realclean Swatch installs just like a CPAN module. If you are not familiar with this process then you may want to read about it by issuing the command: man ExtUtils::MakeMaker Use the "perldoc" command if your "man" cannot find the document. If you see messages like these: Warning: prerequisite Date::Calc 0 not found at (eval 1) line 219. Warning: prerequisite Date::Parse 0 not found at (eval 1) line 219. Warning: prerequisite File::Tail 0 not found at (eval 1) line 219. Warning: prerequisite Time::HiRes 1.12 not found at (eval 1) line 219. Then you need to install the CPAN module(s) that it doesn't find before you can use swatch. You can find these modules at search.cpan.org. However, many operating systems may already bundle them up in neat little packages, so you should check with them first. swatch-3.2.3/KNOWN_BUGS0000644000076500007650000000143610077025676012603 0ustar etaetaKNOWN BUGS - The File::Tail module does not use the input record separator that perl recognizes. It is supposed to be implemented someday. You can get around this problem by using the --read-pipe option if you need to use the --input-record-separator option. This is now only a bug if you use the --use-cpan-file-tail option because I reverted back to using the system's tail command by default. - There are 2 configuration file parsing bugs: 1) Backticking quotes (\") in action option values causes erroneous script production. 2) Commas in action option values confuses the parser. Those of you who are comfortable with perl can work around these two bugs for now by assigning variables with the new perlcode keyword and then using those variables in the action option values. swatch-3.2.3/lib/0000755000076500007650000000000011032472605011674 5ustar etaetaswatch-3.2.3/lib/Swatch/0000755000076500007650000000000011032472605013125 5ustar etaetaswatch-3.2.3/lib/Swatch/Actions.pm0000644000076500007650000002015610425746166015102 0ustar etaetapackage Swatch::Actions; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); require Exporter; @ISA = qw(Exporter AutoLoader); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ring_bell echo exec_command send_message_to_pipe ); $VERSION = '20060502'; # Preloaded methods go here. # Autoload methods go after =cut, and are processed by the autosplit program. ################################################################ # "bell" action # # ring_bell(args) -- ring the terminal bell some number # of times (default is 1) ################################################################ use Time::HiRes qw(sleep); sub ring_bell { my %args = ( 'RINGS' => 1, 'DELAY' => 0.2, @_ ); return if exists($args{'WHEN'}) and not inside_time_window($args{'WHEN'}); return if (exists($args{'THRESHOLDING'}) and $args{'THRESHOLDING'} eq 'on' and not &Swatch::Threshold::threshold(%args)); my $bells = $args{'RINGS'}; for ( ; $bells > 0 ; $bells-- ) { print "\a"; sleep($args{'DELAY'}); } } ################################################################ # "echo" Action ################################################################ use Term::ANSIColor; sub echo { my %args = ( 'MODES' => [ ], @_ ); return if (exists($args{'WHEN'}) and not inside_time_window($args{'WHEN'})); return if (exists($args{'THRESHOLDING'}) and $args{'THRESHOLDING'} eq 'on' and not &Swatch::Threshold::threshold(%args)); if (${$args{'MODES'}}[0] =~ /^normal$/i) { # for backward compatability print "$args{'MESSAGE'}\n"; } else { print colored("$args{'MESSAGE'}\n", @{$args{'MODES'}}); } } ################################################################ # "exec" Action # # exec_command(args) -- fork and execute a command ################################################################ use POSIX ":sys_wait_h"; sub exec_command { my %args = (@_); my $exec_pid; my $command; if (exists $args{'COMMAND'}) { $command = $args{'COMMAND'}; } else { warn "$0: No command was specified in exec action.\n"; return 1; } return 0 if exists($args{'WHEN'}) and not inside_time_window($args{'WHEN'}); return if (exists($args{'THRESHOLDING'}) and $args{'THRESHOLDING'} eq 'on' and not &Swatch::Threshold::threshold(%args)); EXECFORK: { if ($exec_pid = fork) { waitpid(-1, WNOHANG); return 0; } elsif (defined $exec_pid) { exec($command); } elsif ($! =~ /No more processes/) { # EAGAIN, supposedly recoverable fork error sleep 5; redo EXECFORK; } else { warn "$0: Can't fork to exec $command: $!\n"; return 1; } } return 0; } ################################################################ # "mail" Action # # send_email -- send some mail using $MAILER. # # usage: &send_email(%options); # ################################################################ sub send_email { my $login = (getpwuid($<))[0]; my %args = ( 'ADDRESSES' => $login, 'SUBJECT' => 'Message from Swatch', @_ ); return if exists($args{'WHEN'}) and not inside_time_window($args{'WHEN'}); return if (exists($args{'THRESHOLDING'}) and $args{'THRESHOLDING'} eq 'on' and not &Swatch::Threshold::threshold(%args)); if (! $args{'MAILER'} ) { foreach my $mailer (qw(/usr/lib/sendmail /usr/sbin/sendmail)) { $args{'MAILER'} = $mailer if ( -x $mailer ); } if ($args{'MAILER'} ne '') { $args{'MAILER'} .= ' -oi -t -odq'; } } (my $to_line = $args{'ADDRESSES'}) =~ s/:/,/g; local $SIG{CHLD} = 'default'; open(MAIL_PIPE, "| $args{'MAILER'}") or (warn "$0: cannot open pipe to $args{MAILER}: $!\n" and return); print MAIL_PIPE <<"EOF"; To: $to_line Subject: $args{SUBJECT} $args{'MESSAGE'} EOF close(MAIL_PIPE); } ################################################################ # "pipe" Action # # send_message_to_pipe -- send text to a pipe. # # usage: &send_message_to_pipe( # $program_to_pipe_to_including_the_vertical_bar_symbol, # $message_to_send_to_the_pipe); # ################################################################ { my $pipe_is_open; my $current_command_name; sub send_message_to_pipe { my %args = (@_); my $command; if (exists $args{'COMMAND'}) { $command = $args{'COMMAND'}; } else { warn "$0: No command was specified in pipe action.\n"; return; } return if exists($args{'WHEN'}) and not inside_time_window($args{'WHEN'}); return if (exists($args{'THRESHOLDING'}) and $args{'THRESHOLDING'} eq 'on' and not &Swatch::Threshold::threshold(%args)); # open a new pipe if necessary if ( !$pipe_is_open or $current_command_name ne $command ) { # first close an open pipe close(PIPE) if $pipe_is_open; $pipe_is_open = 0; open(PIPE, "| $command") or warn "$0: cannot open pipe to $command: $!\n" && return; PIPE->autoflush(1); $pipe_is_open = 1; $current_command_name = $command; } # send the text print PIPE "$args{'MESSAGE'}"; if (not exists $args{'KEEP_OPEN'}) { close(PIPE) if $pipe_is_open; $pipe_is_open = 0; } } # # close_pipe_if_open -- used at the end of a script to close a pipe # opened by &pipe_it(). # # usage: &close_pipe_if_open(); # sub close_pipe_if_open { if ($pipe_is_open) { close(PIPE); } } } ################################################################ # "write" Action # # write_message -- send a message logged on users. # ################################################################ sub write_message { my %args = (WRITE => '/usr/bin/write', @_); return if exists($args{'WHEN'}) and not inside_time_window($args{'WHEN'}); return if (exists($args{'THRESHOLDING'}) and $args{'THRESHOLDING'} eq 'on' and not &Swatch::Threshold::threshold(%args)); if ($args{WRITE} eq '') { warn "ERROR: $0 cannot find the write(1) program\n"; return; } if (exists($args{'USERS'})) { foreach my $user (split(/:/, $args{'USERS'})) { send_message_to_pipe(COMMAND => "$args{'WRITE'} $user 2>/dev/null", MESSAGE => "$args{'MESSAGE'}\n"); } } } ################################################################ # in_range($range, $number) # returns 1 if $number is inside $range, 0 if not # ################################################################ sub in_range { my $range = shift; my $num = shift; foreach my $f (split(/,/, $range)) { if ($f =~ /-/) { my ($low,$high) = split(/-/, $f); return 1 if ($low <= $num and $num <= $high); } elsif ($f == $num) { return 1; } } return 0; } ################################################################ # inside_time_window($days,$hours) # returns 1 if inside window, 0 if outside window # ################################################################ sub inside_time_window { my $range = shift; my($days, $hours) = split(/:/, $range); my ($hr, $wday) = (localtime(time))[2,6]; if (($days eq '*' or in_range($days, $wday)) and ($hours eq '*' or in_range($hours, $hr))) { return 1; } else { return 0; } } 1; __END__ ################################################################ # Perl Documentation ################################################################ =head1 NAME Swatch::Actions - actions for swatch(1) =head1 SYNOPSIS use Swatch::Actions ring_bell(RINGS => $number_of_times_to_ring, DELAY => $delay_in_seconds, WHEN => $time_window); echo(MESSAGE => 'some text', MODES => @modes); exec(COMMAND => $command_string, WHEN => $time_window); =head1 DESCRIPTION =head1 AUTHOR E. Todd Atkins - Todd.Atkins@StanfordAlumni.ORG =head1 SEE ALSO swatch(1), Term::ANSIColor(1), perl(1). =cut swatch-3.2.3/lib/Swatch/Threshold.pm0000644000076500007650000001246310460236721015426 0ustar etaetapackage Swatch::Threshold; require 5.000; require Exporter; use strict; use Carp; use Date::Calc; use Date::Manip; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); @ISA = qw(Exporter); @EXPORT = qw/ threshold /; $VERSION = '20060721'; # # $thresholds = ( # List of Hashes # => { # swatch ID generated for each "watchfor" value # => { # TRACK_BY value # FIRST => seconds # time of first instance of this key # EVENTS => , # num of logs seen since last report # }, # => { # ... # }, # ... # }, # => { # ... # }, # ... # ); my $thresholds = {}; my $debug = 1; ################################################################ # threshold() - ################################################################ sub threshold { my %opts = ( SWID => '0', DEBUG => 0, # TYPE # TRACK_BY # COUNT # SECONDS @_ ); my ($takeAction,$doNothing) = (1,0); my $withinInterval = 1; my $time = time(); my $endOfInterval = 0; if (exists($thresholds->{$opts{SWID}}) and exists($thresholds->{$opts{SWID}}{$opts{TRACK_BY}})) { $endOfInterval = $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{FIRST} + $opts{SECONDS}; $withinInterval = ($endOfInterval > $time) ? 1 : 0; } ####### TYPE is LIMIT ####### if ($opts{TYPE} eq 'limit') { # # Alert on the 1st COUNT events during the time interval, then ignore events # for the rest of the time interval. # if (exists($thresholds->{$opts{SWID}}{$opts{TRACK_BY}})) { if ($thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{EVENTS} < $opts{COUNT}) { $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{EVENTS}++; return $takeAction; } elsif (not $withinInterval) { $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{EVENTS} = 1; $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{FIRST} = $time; return $takeAction; } else { return $doNothing; } } else { add_threshold(%opts); return $takeAction; } ####### TYPE is THRESHOLD ####### } elsif ($opts{TYPE} eq 'threshold') { # # Alert every COUNT times we see this event during the time interval. # if (exists($thresholds->{$opts{SWID}}{$opts{TRACK_BY}})) { $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{EVENTS}++; if ($withinInterval) { if ($thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{EVENTS} == $opts{COUNT}) { $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{EVENTS} = 0; return $takeAction; } else { return $doNothing; } } else { ### not $withinInterval ### $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{FIRST} = $time; $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{EVENTS} = 1; } } else { add_threshold(%opts); } if ($opts{COUNT} == 1) { $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{EVENTS} = 0; return $takeAction; } else { return $doNothing; } ####### TYPE is BOTH ####### } elsif ($opts{TYPE} eq 'both') { # # Alert once per time interval after seeing COUNT occurrences of the event, # then ignore any additional events during the time interval. # if (exists($thresholds->{$opts{SWID}}{$opts{TRACK_BY}})) { $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{EVENTS}++; if ($withinInterval and $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{EVENTS} == $opts{COUNT}) { return $takeAction; } elsif (not $withinInterval) { $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{EVENTS} = 1; $thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{FIRST} = $time; } } else { add_threshold(%opts); } if ($thresholds->{$opts{SWID}}{$opts{TRACK_BY}}{EVENTS} == $opts{COUNT}) { return $takeAction; } else { return $doNothing; } ####### TYPE is incorrectly defined ####### } else { die "Swatch::Threshold - unknown type, $opts{TYPE} given\n"; } } ################################################################ sub add_threshold { my %opts = (@_); my $rec = {}; $rec->{EVENTS} = 1; $rec->{FIRST} = time(); $thresholds->{$opts{SWID}}{$opts{TRACK_BY}} = $rec; } ################################################################ ## The POD ### =head1 NAME Swatch::Threshold - Perl extension for thresholding in swatch(1) =head1 SYNOPSIS use Swatch::Threshold; &Swatch::threshold( SWID => , TYPE => , TRACK_BY => , # like an IP addr COUNT => , SECONDS => ); =head1 SWATCH SYNTAX threshold track_by=, type=, count=, seconds= =head1 DESCRIPTION SWID is swatch's internal ID number for the watchfor block TYPE can be limit, threshold, or both Limit - Alert on the 1st COUNT events during the time interval, then ignore events for the rest of the time interval. Threshold - Alert every COUNT times we see this event during the time interval. Both Alert once per time interval after seeing COUNT occurrences of the event, then ignore any additional events during the time interval. SECONDS is the time interval =head1 AUTHOR E. Todd Atkins, todd.atkins@stanfordalumni.org =head1 SEE ALSO perl(1), swatch(1). =cut 1; swatch-3.2.3/lib/Swatch/Throttle.pm0000644000076500007650000001344710077025676015313 0ustar etaetapackage Swatch::Throttle; require 5.000; require Exporter; use strict; use Carp; use Date::Calc; use Date::Manip; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); @ISA = qw(Exporter); @EXPORT = qw/ flushLogRecords throttle readHistory saveHistory /; $VERSION = '20030701'; # # %LogRecords = ( # => { # keyed by "key" below # KEY => , # generated key # FIRST => @dmyhms, # time of first log # LAST => @dmyhms, # time of last log # COUNT => , # num of logs seen since last report # }, # ); my %LogRecords = (); ################################################################ sub readHistory { my $file = shift; my $return; if (-f $file) { unless ($return = do $file) { warn "couldn't parse $file: $@" if $@; warn "couldn't do $file: $!" unless defined $return; warn "couldn't run file" unless $return; } } return; } ################################################################ sub saveHistory { my $file = shift; my $fh = new FileHandle $file, "w"; my $date = localtime(time); if (defined $fh) { $fh->print(q/ ################################################################ # THIS FILE WAS GENERATED BY SWATCH AT $date. # DO NOT EDIT!!! ################################################################ $Swatch::Throttle::LogRecords = ( /); foreach my $key ( keys %LogRecords ) { $fh->print("\t'$key' => {\n"); foreach my $attr ( keys %{ $LogRecords{$key} } ) { $fh->print("\t\t$attr => "); if ($attr =~ /FIRST|LAST|HOLD_DHMS/) { $fh->print("[ "); foreach my $elem (@{ $LogRecords{$key}{$attr} }) { $fh->print("\'$elem\', "); } $fh->print("],\n"); } else { $fh->print("\"$LogRecords{$key}{$attr}\",\n"); } } $fh->print("\t},\n"); } $fh->print(");\n"); $fh->close; } else { } } ################################################################ # throttle() - returns the ################################################################ sub throttle { my %opts = ( MESSAGE => $_, EXTRA_CUTS => [], # regex(s) used for creating key if key=log KEY => 'log', TIME_FROM => 'realtime', TIME_REGEX => '^(\w{3}\s+\d{1,2}\s+\d{2}:\d{2}:\d{2})\s+', @_ ); my @dmyhms; my $key; my $cur_rec; my $msg = $opts{"MESSAGE"}; ## get the time ## if ($opts{TIME_FROM} eq 'realtime') { @dmyhms = Date::Calc::Today_and_Now(); } else { if ($opts{MESSAGE} =~ /$opts{TIME_REGEX}/ and $1 ne '') { my $date = Date::Calc::ParseDate($1); if (not $date) { warn "Cannot parse date from \"$opts{MESSAGE}\" using \"$opts{TIME_REGEX}\"\n"; } else { @dmyhms = Date::Manip::UnixDate($date, "%Y", "%m", "%d", "%H", "%M", "%S"); } } } ## get the key ## if ($opts{KEY} eq 'log') { $key = $opts{MESSAGE}; $key =~ s/$opts{TIME_REGEX}//; if (defined $opts{EXTRA_CUTS}) { foreach my $re (@{ $opts{EXTRA_CUTS} }) { $key =~ s/$re//g; } } } else { $key = $opts{KEY}; } ## just make the record if it doesn't exist yet ## if (not defined $LogRecords{$key}) { my $rec = (); $rec->{KEY} = $key; $rec->{FIRST} = [ @dmyhms ]; $rec->{LAST} = [ @dmyhms ]; $rec->{HOLD_DHMS} = $opts{HOLD_DHMS} if defined $opts{HOLD_DHMS}; $rec->{COUNT} = 1; $LogRecords{$key} = $rec; return $msg; } else { $cur_rec = $LogRecords{$key}; $cur_rec->{COUNT}++; if (defined $opts{THRESHOLD} and $cur_rec->{COUNT} == $opts{THRESHOLD}) { ## threshold exceeded ## chomp $msg; $msg = "$msg (threshold $opts{THRESHOLD} exceeded)"; $cur_rec->{COUNT} = 0; } elsif (defined $opts{HOLD_DHMS} and past_hold_time($cur_rec->{LAST}, \@dmyhms, $opts{HOLD_DHMS})) { ## hold time exceeded ## chomp $msg; $msg = "$msg (seen $cur_rec->{COUNT} times)"; $cur_rec->{COUNT} = 0; $cur_rec->{LAST} = [ @dmyhms ]; } else { $msg = ''; } $LogRecords{$key} = $cur_rec if exists($LogRecords{$key}); ## save any new values ## } return $msg; } ################################################################ # Checks to see if the current time is less than the last # time plus the minimum hold time. ################################################################ sub past_hold_time { my $last = shift; ## pointer to YMDHMS array of last message my $cur = shift; ## pointer to YMDHMS array of current message my $hold = shift; ## pointer to DHMS array of min. hold time my @ymdhms = Date::Calc::Add_Delta_DHMS( @{ $last }, @{ $hold } ); my @delta = Date::Calc::Delta_DHMS( @ymdhms, @{ $cur } ); return( $delta[0] > 0 or $delta[1] > 0 or $delta[2] > 0 or $delta[3] > 0 ); } ################ sub flushOldLogRecords { my @dmyhms = Date::Calc::Today_and_Now(); foreach my $key (keys %LogRecords) { if (defined $LogRecords{$key}->{HOLD_DHMS}) { if (past_hold_time($LogRecords{$key}->{LAST}, \@dmyhms, $LogRecords{$key}->{HOLD_DHMS}) and $LogRecords{$key}->{COUNT} == 0) { delete($LogRecords{$key}); } } } } ## The POD ### =head1 NAME Swatch::Throttle - Perl extension for throttling and thresholding in swatch(1) =head1 SYNOPSIS use Swatch::Throttle; throttle( extra_cuts => @array_of_regular_expressions, hold_dhms => @DHMS, key => 'log'||, log_msg => , threshold => , time_from => 'realtime'|'timestamp', time_regex => , ); =head1 SWATCH SYNTAX throttle threshold=,\ delay=::,\ key=log|regex| =head1 DESCRIPTION =head1 AUTHOR E. Todd Atkins, todd.atkins@stanfordalumni.org =head1 SEE ALSO perl(1), swatch(1). =cut 1; swatch-3.2.3/Makefile.PL0000644000076500007650000000144710455534711013113 0ustar etaetause ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'swatch', 'VERSION_FROM' => 'swatch', 'EXE_FILES' => [ 'swatch' ], 'PREREQ_PM' => { 'Time::HiRes' => '1.12', 'Date::Calc' => '0', 'Date::Format' => '0', 'Date::Manip' => '0', 'File::Tail' => '0', 'Term::ANSIColor' => '0', }, 'dist' => { 'SUFFIX' => ".gz", 'DIST_DEFAULT' => 'all tardist', 'COMPRESS' => "gzip -9f" }, 'realclean' => { 'FILES' => '' }, 'clean' => { 'FILES' => '' }, ); swatch-3.2.3/MANIFEST0000644000076500007650000000046410425745114012266 0ustar etaetaMANIFEST README CHANGES COPYRIGHT COPYING INSTALL KNOWN_BUGS Makefile.PL examples/SendMail.pm tools/reswatch tools/swatch_oldrc2newrc swatch t/01cpan_modules.t lib/Swatch/Actions.pm lib/Swatch/Throttle.pm lib/Swatch/Threshold.pm META.yml Module meta-data (added by MakeMaker) swatch-3.2.3/META.yml0000644000076500007650000000100311032472605012371 0ustar etaeta# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: swatch version: 3.2.3 version_from: swatch installdirs: site requires: Date::Calc: 0 Date::Format: 0 Date::Manip: 0 File::Tail: 0 Term::ANSIColor: 0 Time::HiRes: 1.12 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30 swatch-3.2.3/README0000644000076500007650000001157110343703521012011 0ustar etaeta Thank you for your interest in swatch: the Simple WATCHdog. Swatch is a SourceForge project whose project page is at http://sourceforge.net/projects/swatch and homepage is at http://swatch.sourceforge.net Swatch was originally written to actively monitor messages as they are written to a log file via the UNIX syslog utility. For a simple demonstration type "perl swatch --examine=FILENAME" with FILENAME being the file that you would like to see the contents of. All this example will do is demonstrate the different text modes that are available with to the echo action. Read the INSTALL file for installation instructions. IF YOU ENCOUNTER A BUG... Please send mail to todd.atkins@stanfordalumni.org about it, but first make sure that it is not mentioned in the KNOWN_BUGS file and that you are using the latest release. MAJOR CHANGES IN VERSION 3.1 Added --extra-include-dirs (or -I) and --extra-modules (or -M) command line options. This allows one to extend the functionality of swatch by defining customized actions. See the modules in the "examples" directory to see how this feature can be used. Changed "-I" command option from being shorthand for "--input-record-separator" to being short for "--extra-include-dirs" in order to be more consistent with perl's command line arguments. Added --tail-program-name and --tail-args command line options. This allows one to use more robust tail commands like GNU tail. Here is how I use it to watch multiple files and not have to worry when they get rotated: % swatch --tail-prog=/usr/local/bin/gtail \ --tail-args '--follow=name --lines=1' \ --tail-file="/var/log/messages /var/log/snort/alert" Added possibility for user to overide "message" option to any action. Changed default tail arguments from "-1 -f" to "-n 0 -f" Put action and throttle code into modules named Swatch::Actions and Swatch::Throttle respectively. Added --awk-field-syntax and --noawk-field-syntax command line options with --noawk-field-syntax now set as the default Added option for user to use their own regular expression to extract a throttle key from a message using greedy pattern matching. Went back to using the system's tail(1) command for tailing files due to all of the problems that folks were experiencing with the File::Tail CPAN module. Added --use-cpan-file-tail option to users to keep using the File::Tail module for tailing files. Added perlcode to configuration file. This allows for perl hackers to make use of variables in their configuration files. There is a depth setting which allows the perlcode to be placed in different levels of the nested blocks that are used in the watcher script. Here is how one could use it to define generic regular expressions for matching and defining fields for different styles of log file lines: # matches Snort pre-processor short alerts perlcode my $spp_regex = '\[\*\*\]\s+(\[\d+:\d+:\d+\])\s+([^:]*):.*from (\d+\.\d+\.\d+\.\d+)(.*)$'; # matches short Snort alerts ($1 = alert message, $2 = src IP) perlcode my $snort_regex = '\[\*\*\]\s+(.*)\s+\[\*\*\].*\{\w+\} (\d+\.\d+\.\d+\.\d+)'; # matches syslog lines ($1 set to everything after the timestamp) perlcode my $syslog_regex = '^\w{3}\s+\d{1,2}\s+\d{2}:\d{2}:\d{2}.*:(.*)'; # report every type of snort alert but throttle them watchfor /.*/ and /$snort_regex/ throttle 5:00,key=$1 $2 echo modes=green # report every type of syslog message but throttle them watchfor /.*/ and /$syslog_regex/ throttle 5:00,key=$1 echo modes=green OTHER MAJOR CHANGES SINCE VERSION 2.X The configuration file now has a completely different format. You can still use your old configuration files if you use the "--old-style-config" switch if you insist. I have re-written most a lot of the code to take advantage of features and modules that were made available with perl 5. It now requires perl 5 and the following modules: Time::HiRes, Date::Calc, Date::Format, Date::Manip, Term::ANSIColor, File::Tail. I have added the seven colors that color xterminals recognize to the echo action. The manual is now embedded into the script in POD format. Use pod2text, pod2html, or your favorite pod2* program to create a more easily readable document. FUTURE DIRECTIONS I am working on a thresholding module that will behave in a manner that is similar to thresholding in the Snort IDS (www.snort.org). This should eventually replace the current throttling mechanism. SUGGESTIONS? Please mail suggestions, problems, and/or complaints about swatch to Todd.Atkins@StanfordAlumni.ORG DONATIONS? The swatch program is provided to you free of charge. However, if you find it useful I encourage you to send in a donation toward its continuous development. Please send donations online via PayPal (www.paypal.com) using my todd.atkins@stanfordalumni.org address Thank you. swatch-3.2.3/swatch0000555000076500007650000010536411032472367012361 0ustar etaeta#!/usr/bin/perl eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}' if 0; # not running under some shell # # swatch: The Simple WATCHdog # Copyright (C) 1993-2008 E. Todd Atkins # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # use strict; use English; use FileHandle; use Getopt::Long; use IO::Handle; use POSIX ":sys_wait_h"; use Date::Parse; use Date::Format; use Pod::Usage; use vars qw/ $commandLineString $awk_field_syntax $opt_config_file $opt_daemon $opt_debug_level $opt_dump_script $opt_examine @extra_modules @extra_include_dirs $opt_help $opt_input_record_separator $opt_old_style_config $opt_pid_file $opt_style_config $opt_read_pipe $opt_restart_time $opt_tail_file $opt_script_dir $opt_version @Config $Done $Restart $VERSION $Now $pid $thCounter $tail_cmd_args $tail_cmd_name $use_cpan_file_tail /; my @Swatch_ARGV = join(' ', $0, @ARGV); # Save just in case we need to restart (my $Me = $0) =~ s%.*/%%; # Strip the path off of the program name $SIG{'CHLD'} = 'DEFAULT'; my $DEF_CONFIG_FILE = "$ENV{'HOME'}/.swatchrc"; my $DEF_INPUT; if ( -f '/var/log/messages' ) { $DEF_INPUT = '/var/log/messages'; } elsif ( -f '/var/log/syslog' ) { $DEF_INPUT = '/var/log/syslog'; } my $Config_File = ''; my $Now = 0; # The current time in Unix seconds. Gets set when set_restart_time is called my $thCounter = 0; my $tail_cmd_name = ''; # We'll try to find it in the PATH later my $tail_cmd_args = '-n 0 -F'; $awk_field_syntax = 0; my $AUTHOR = "E. Todd Atkins "; $VERSION = "3.2.3"; my $BUILD_DATE = "May 7, 2008"; my $swID = 0; # Main ID used for threshold functionality within # watchfor blocks my $swIDSub = 0; # Secondary ID used for threshold functionality # within individule actions (not implemented yet) my $commandLineString = $0 . ' ' . join(' ', @ARGV); sub print_version { print "This is $Me version $VERSION\n"; print "Built on $BUILD_DATE\n"; print "Built by $AUTHOR\n"; exit 0; } sub parse_command_line { use Getopt::Long; Getopt::Long::config('bundling'); pod2usage if not GetOptions( "awk-field-syntax!" => \$awk_field_syntax, "config-file|c=s" => \$opt_config_file, "daemon" => \$opt_daemon, "debug:i" => \$opt_debug_level, "extra-module|M=s@" => \@extra_modules, "extra-include-dir|I=s@" => \@extra_include_dirs, "help|h" => \$opt_help, "input-record-separator:s" => \$opt_input_record_separator, "old-style-config|O" => \$opt_old_style_config, "pid-file=s" => \$opt_pid_file, "restart-time|r=s" => \$opt_restart_time, "tail-args=s" => \$tail_cmd_args, "tail-program-name=s" => \$tail_cmd_name, "tail-file|t=s" => \$opt_tail_file, "read-pipe|p=s" => \$opt_read_pipe, "examine|f=s" => \$opt_examine, "script-dir=s" => \$opt_script_dir, "use-cpan-file-tail" => \$use_cpan_file_tail, "version|V" => \$opt_version, "dump-script:s" => \$opt_dump_script, ); pod2usage if $opt_help; if ($opt_version) { print_version; exit(0); } $opt_input_record_separator = (defined $opt_input_record_separator) ? $opt_input_record_separator : $/; # This is slightly bogus -- we call the set_restart_time function now # because if the args aren't properly formatted, we want to die before the fork set_restart_time($opt_restart_time) if defined $opt_restart_time; } ### ### Routines to help with debugging ### sub dprint { my $msg_lev = shift; my $msg = shift; print STDERR "DEBUG($msg_lev): $msg\n" if ($msg_lev & $opt_debug_level); } # # make_debug_code() - creates the debug code for the watcher script # sub make_debug_code { my $code = ''; $code = sprintf("my \$Debug_Mode = %d;\n", defined $opt_debug_level ? $opt_debug_level : 0); $code .= q| sub dprint { my $msg_lev = shift; my $msg = shift; print STDERR "DEBUG($msg_lev): $msg\n" if ($msg_lev & $Debug_Mode); } |; return $code; } # # checks validity of a regular expression. returns 1 if valid. # sub is_valid_pattern { my $pat = shift; return eval { "" =~ /$pat/; 1 } || 0; } # # Build a configuration record structure # { my @records; sub read_config { my $filename = shift; my $rec = (); my $i = -1; my $keyword; my $pattern; my $option; my $value; my $fh; if ( not -r $filename ) { die "$Me: cannot find $filename. Please create it or specify an alternate configuration file. Exiting.\n"; } $fh = new FileHandle "$filename", "r"; if (not defined $fh) { warn "$Me: cannot open $filename: $!\n"; exit 1; } while (<$fh>) { my($key, $val); chomp; s/^\s+//; ## strip off leading blank space s/\s+$//; ## strip off trailing blank space ### Skip comments and blank lines ### next if (/^\#/ or /^$/); s/\#.*$//; ## strip trailing comments ### combine lines that end with \ + ### while (/\\$/) { my $line; s/\\$//; if (defined($line = <$fh>) and not $line =~ /^\#/ and not $line =~ /^$/) { chomp($line); s/^\s+//; ## strip off leading blank space s/\s+$//; ## strip off trailing blank space $_ .= $line; } } if (/\s*=\s*/) { $key = (split(/\s*[= ]\s*/))[0]; ($val = substr($_, length($key))) =~ s/^\s*=\s*//; } else { $key = (split())[0]; ($val = substr($_, length($key))) =~ s/^\s*//; } if ($key =~ /include/i) { @records = read_config($val); } elsif ($key =~ /^(watchfor|waitfor|ignore)$/i) { $i++; if (defined $rec->{pattern}) { push @records, $rec; $rec = (); } if (not is_valid_pattern($val)) { die "$Me: error in pattern \"$val\" on line $. of $filename\n"; } $rec->{keyword} = lc($key); if (length($val)) { $rec->{pattern} = $val; } } elsif ($key =~ /perlcode/i) { my $depth = 1; if ($val =~ /(\d+)\s+(.*)$/) { # put perlcode at a given depth $depth = $1; $val = $2; } if ($depth < 2) { $i++; if (defined $rec->{pattern}) { push @records, $rec; $rec = (); } $rec->{keyword} = lc($key); $rec->{depth} = $depth; $rec->{value} = $val if (length($val)); push @records, $rec; $rec = (); } else { # depth is 2 push(@{$rec->{actions}}, { action => lc($key), depth => $depth, value => $val }); } } elsif ($i < 0) { warn "$Me: error in $filename at line ${.}: invalid keyword. Skipping.\n"; } elsif ($key =~ /^(throttle|threshold)$/i) { $rec->{lc($key)}{value} = $val; } else { push(@{$rec->{actions}}, { action => $key, value => $val }); } } undef $fh; if (defined $rec->{pattern}) { push @records, $rec; $rec = (); } ## Sanity Check: If the config file did not contain anything useful then exit if ($#records < 0) { die "$Me: There were no useful entries in the configuration file. Exiting.\n"; } else { return(@records); } } } sub read_old_config { my $filename = shift; my $fh = new FileHandle $filename, "r"; my @records = (); if (not defined $fh) { die "$Me: cannot read $filename: $!\n"; } while (<$fh>) { my $rec = (); chomp; @_ = split(/\t+/); if (/^\s*$/ or /^\s*\#/) { next; } elsif (/ignore/) { $rec->{keyword} = 'ignore'; $rec->{pattern} = $_[0]; } else { $rec->{keyword} = 'watchfor'; $rec->{pattern} = $_[0]; if (defined $_[2] and $_[2] =~ /^[0-9]/) { $rec->{'throttle'}->{value} = $_[2]; } foreach my $action (split(/,/, $_[1])) { my ($key,$val) = split(/\s*=\s*/, $action); push(@{$rec->{actions}}, { action => $key, value => $val }); } } push(@records, $rec); } return (@records); } # # make_start_code -- return the start of our swatch generated perl script # # usage: $script .= make_start_code; # sub make_start_code { my $code = ''; my $mail_cmd = ''; my $extra_includes = ''; my $extra_modules = ''; if ($#extra_modules != -1) { foreach my $m (@extra_modules) { $extra_modules .= "use $m;\n"; } } if ($#extra_include_dirs != -1) { $extra_includes = join(' ', @extra_include_dirs); } $code = qq[ # # swatch: The Simple WATCHdog # Copyright (C) 1993-2006 E. Todd Atkins # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # use strict; use FileHandle; use POSIX ":sys_wait_h"; ## User supplied modules and their locations use lib qw($extra_includes); $extra_modules use Swatch::Actions; use Swatch::Throttle; use Swatch::Threshold; use vars qw/ %Msg_Rec \$Fh /; \$SIG{'TERM'} = \$SIG{'HUP'} = 'goodbye'; \$SIG{'CHLD'} = 'DEFAULT'; ## Constants (my \$Me = \$0) =~ s%.*/%%; my \$BELL = "\007"; \$/ = "$opt_input_record_separator"; my \$swatch_flush_interval = 300; my \$swatch_last_flush = time; my \$tail_pid = -1; use IO::Handle; STDOUT->autoflush(1); sub goodbye { \$| = 0; if( \$tail_pid != -1 ) { kill('TERM', \$tail_pid); } ]; if ($opt_read_pipe) { $code .= " close(SW_PIPE);\n"; } elsif ($opt_examine) { $code .= " \$Fh->close;\n"; } $code .= q| &Swatch::Actions::close_pipe_if_open(); exit(0); } # # write_pid_file(file_name) - writes a one line file that contains # the current process id. # sub write_pid_file { my $name = shift; my $fh = new FileHandle "$name", "w"; if (defined($fh)) { print $fh "$$\n"; $fh->close; } else { warn "$Me: cannot write pid file named $name: $!\n"; } } |; if ($opt_daemon) { $code .= qq[ my \$pid = fork; exit if \$pid; die "Couldn't fork: \$!" unless defined(\$pid); # dissociate from the controlling terminal POSIX::setsid() or die "Can't start new session: \$!"; # set our named to 'swatch' so that rc scripts can # figure out who we are. \$0="$commandLineString"; ]; } else { $code .= qq[print \"\\n*** ${Me} version ${VERSION} (pid:$$) started at \" . `/bin/date` . \"\\n\";]; } $code .= qq[write_pid_file("$opt_pid_file"); \n] if (defined $opt_pid_file); return $code; } sub make_start_loop { my $filename = $DEF_INPUT; my $code = ''; if (defined $opt_examine) { $filename = $opt_examine; $code = qq[ use FileHandle; my \$Filename = '$filename'; \$Fh = new FileHandle \"\$Filename\", 'r'; if (not defined \$Fh) { die "$0: cannot read input \\"\$Filename\\": \$!\\n"; } LOOP: while (<\$Fh>) { ]; } elsif (defined $opt_read_pipe) { $filename = $opt_read_pipe; $code = qq[ use FileHandle; my \$Filename = '$filename'; if (not open(SW_PIPE, \"$filename|\")) { die "$0: cannot read from pipe to program \\"\$Filename\\": \$!\\n"; } LOOP: while () { ]; } else { $filename = $opt_tail_file if (defined $opt_tail_file); if ($use_cpan_file_tail) { $code = qq[ use File::Tail; my \$Filename = '$filename'; my \$File = File::Tail->new(name=>\$Filename, tail=>1, maxinterval=>0.5, interval=>0.5); if (not defined \$File) { die "$0: cannot read input \\"\$Filename\\": \$!\\n"; } LOOP: while (defined(\$_=\$File->read)) { ]; } else { if ($tail_cmd_name eq '') { foreach my $path (split(/:/,$ENV{'PATH'})) { if (-x "${path}/tail") { $tail_cmd_name = "$path/tail"; last; } } die "$Me: cannot find \"tail\" program in PATH\n" if $tail_cmd_name eq ''; } $code = qq/ my \$filename = '$filename'; \$tail_pid = open(TAIL, \"$tail_cmd_name $tail_cmd_args \$filename|\"); if (not \$tail_pid) { die "$0: cannot read run \\"$tail_cmd_name $tail_cmd_args \$filename\\": \$!\\n"; } LOOP: while () { /; } } $code .= q! chomp; my $S_ = $_; @_ = split; ### quote all special shell chars ### $S_ =~ s/([;&\(\)\|\^><\$`'\\\\])/\\\\$1/g; my @S_ = split(/\s+/, $S_); !; } sub make_end_code { my $code; $code = q[ } ## TODO: Add close !!! ]; return $code; } sub action_def_to_subroutine_call { my $key = shift; # converts to subroutine name my $optstr = shift; # comma separated option string my $pattern = shift; my $message = shift; my $actinfo = { # action subroutine info "continue" => { 'sub_name' => "continue" }, "bell" => { 'sub_name' => "&Swatch::Actions::ring_bell", 'def_arg' => 'RINGS' }, "echo" => { 'sub_name' => "&Swatch::Actions::echo", 'def_arg' => 'MODES' }, "exec" => { 'sub_name' => "&Swatch::Actions::exec_command", 'def_arg' => 'COMMAND' }, "pipe" => { 'sub_name' => "&Swatch::Actions::send_message_to_pipe", 'def_arg' => 'COMMAND' }, "mail" => { 'sub_name' => "&Swatch::Actions::send_email", 'def_arg' => 'ADDRESSES' }, "quit" => { 'sub_name' => "exit" }, "throttle" => { 'sub_name' => '&Swatch::Throttle::throttle', 'def_arg' => 'MIN_DELTA' }, "write" => { 'sub_name' => "&Swatch::Actions::write_message", 'def_arg' => 'USERS' }, }; my %options; my $have_opts = 0; foreach my $v (split(/,/, $optstr)) { if ($v =~ /(\w+)\s*=\s*"?(\S+[^"]*)/) { $options{uc $1} = $2; } else { my $opt = $v; $opt =~ s/@/\\@/g; $opt =~ s/^\s+//o; $opt =~ s/^\s+$//o; $opt = $1 if ($opt =~ /^['"]\s*(.*)\s*['"]$/o); $opt =~ s/"/\\"/go; if ($actinfo->{$key}{'def_arg'} eq 'MODES') { ## Modes are processed as an array ## push(@{$options{$actinfo->{$key}{'def_arg'}}}, $opt); } else { $options{$actinfo->{$key}{'def_arg'}} = $opt; } } } if ($key =~ /(exec|pipe)/) { $options{'COMMAND'} = convert_command('S_', $options{'COMMAND'}); } $options{'MESSAGE'} = $message unless exists $options{'MESSAGE'}; my $opts = ''; if (scalar %options) { if ($key eq 'threshold') { $opts = "\'SWID\' => \'$swID\', "; } foreach my $k (keys %options) { if ($k eq 'MODES') { $opts .= "\'$k\' => [ "; foreach my $v (@{$options{$k}}) { $opts .= "\"$v\","; } $opts .= " ], "; } elsif ($k eq 'MIN_DELTA') { ## convert to new throttle variable name ## $opts .= "\'HOLD_DHMS\' => [ "; my @dhms = split(/:/,$options{$k}); for (my $i = $#dhms ; $i < 3 ; $i++) { unshift(@dhms, 0); } foreach my $v (@dhms) { $opts .= "\"$v\","; } $opts .= " ], "; } else { $opts .= "\'$k\' => \"$options{$k}\", "; # if (defined $options{$k}); } if ($k eq 'THRESHOLD') { $opts .= "\'SWID\' => \'$swID:$swIDSub\', "; } } } my $sub_name = (exists $actinfo->{$key}{'sub_name'}) ? $actinfo->{$key}{'sub_name'} : $key; return "$sub_name($opts)"; } # # convert_command -- convert wildcards for fields in command from # awk type to perl type. Also, single quote wildcards # for better security. # usage: &convert_command($Command); sub convert_command { my $varname = shift; my $command = shift; my @new_cmd = (); $command =~ s/\$[0*]/\$$varname/g if $awk_field_syntax; foreach my $i (split(/\s+/, $command)) { if ($awk_field_syntax and $i =~ /\$([0-9]+)/) { my $n = substr($i, 1); $n--; push(@new_cmd, "\$$varname\[$n\]"); } else { push(@new_cmd, $i); } } return join(' ', @new_cmd); } sub make_ignore_block { my $ref = shift; dprint(4, "ignoring $ref->{pattern}"); return "\tnext;\n"; } sub make_watchfor_block { my $pattern = shift; my $ref = shift; my $code = ""; my $do_quit = 0; my $do_continue = 0; my $message = '$_'; $swID++; # increment internal identifier $swIDSub = 0; # reset internal sub identifier foreach my $a_ref (@{$ref->{actions}}) { if ($a_ref->{action} eq 'perlcode' and $a_ref->{depth} == 2) { $code .= "\t$a_ref->{value}\n"; } } # Encapsulate the whole thing (even throttle) in a threshold block. The # indenting in the generated code is "wrong", but there is no easy way to # fix it. if (exists $ref->{"threshold"}) { $code .= " if ("; $code .= action_def_to_subroutine_call('threshold', $ref->{'threshold'}{value}, $pattern, $message); $code .= ") {\n"; } if (exists $ref->{"throttle"}) { $code .= " if ((my \$rtn = "; $code .= action_def_to_subroutine_call('throttle', $ref->{'throttle'}{value}, $pattern, $message); $code .= ") ne '') {\n"; $message = '$rtn'; } dprint(4,"watching $ref->{pattern}"); foreach my $a_ref (@{$ref->{actions}}) { $swIDSub++; # increment internal sub identifier my $act = $a_ref->{action}; if ($act eq 'perlcode' and $a_ref->{depth} == 3) { $code .= "\t$a_ref->{value}\n"; } elsif ($act eq 'continue') { $do_continue = 1; } elsif ($act eq 'quit') { $do_quit = 1 } elsif ($act ne 'perlcode') { $code .= "\t"; $code .= action_def_to_subroutine_call($act, $a_ref->{value}, undef, $message); $code .= ";\n"; } } if (exists $ref->{"throttle"}) { $code .= " }\n"; } if (exists $ref->{"threshold"}) { $code .= " }\n"; } if ($do_quit) { $code .= " exit;\n"; } elsif (not $do_continue) { $code .= " next;\n"; } return $code; } # # make_script() - The workhorse for creating the script that will do the # message processing. # # returns a string which contains the full script. # sub make_script { my $key; my $block_open = 0; my $script = make_start_code(); for my $rec (@Config) { if ($rec->{keyword} eq 'perlcode' and $rec->{depth} == 0) { $script .= "$rec->{value}\n"; } } $script .= make_start_loop(); for my $rec (0..$#Config) { my $pattern = $Config[$rec]->{pattern}; my $config = $Config[$rec]; if ($block_open) { $script .= " }\n\n"; $block_open = 0; } $key = $config->{keyword}; if ($key =~ /^perlcode$/ and $config->{depth} == 1) { $script .= " $config->{value}\n"; $block_open = 0; } elsif ($key !~ /^perlcode$/) { $script .= " if ($pattern) {\n"; $block_open = 1; } if ($key =~ /^ignore$/) { $script .= make_ignore_block($config); } elsif ($key =~ /^watchfor$/) { $script .= make_watchfor_block($pattern, $config); } } $script .= " }\n"; $script .= make_end_code; return $script; } # # terminate # # usage: terminate($SIGNAL); # sub terminate { my($Sig) = shift; dprint(16, "terminate($Sig)"); return if $pid == 0; if ($Sig) { print STDERR "Caught a SIG$Sig -- sending a TERM signal to $pid\n" } kill('TERM', $pid) unless $opt_dump_script; $Restart = 0; } # # restart -- kill the child, delete the script, and start over. # # usage: &restart($Sig); # sub restart { my($Sig) = shift; dprint(16, "restart($Sig)"); print STDERR "Caught a SIG$Sig -- sending a TERM signal to $pid\n"; kill('TERM', $pid); $Restart = 1; } ## Courtesy of "Shoshana Abrass" ... ## ## USAGE: set_restart_time(timestring) ## WHICH: converts the user-given timestring into the time (in unix ## seconds) when the program should next restart ## WHERE: "timestring" is one of the supported command-line arguments, ## for example: ## ## 00:01 restart every day at 12:01 AM ## +24:00 restart every 24 hours ## +1:00 restart every hour ## ## There is currently no way to say "restart at the next HH:00 and every ## hour after that", but it might be a nice feature. ## ## RETURNS: seconds since Jan 1 1970 of the next restart time. ## sub set_restart_time{ my ($timestring)=(@_); my ($DeltaHrs, $DeltaMins, $RestartTime); my ($OneMinute, $OneHour, $OneDay) = (60, 3600, 86400); # In seconds my ($EndOfTime) = (2147483647); # Mon Jan 18 19:14:07 2038 $Now = time(); if ( $timestring =~ m/^\+/ ) { if ( $timestring =~ m/^\+(\d+):(\d+)$/ ) { # # $DeltaHrs = $1 * $OneHour; $DeltaMins = $2 * $OneMinute; $RestartTime = $Now + $DeltaHrs + $DeltaMins; if ( $RestartTime >= $EndOfTime ) { print "ERROR: Restart time delta would put us past the end of\n"; print " unix time, ", ctime ($EndOfTime); die " Unacceptable time delta\n"; } } else { die "Unrecognized delta time format \"$timestring\"\n"; } } else { if ( ! ($RestartTime = str2time("$timestring")) ) { die "Unrecognized time format \"$timestring\"\n"; } while ( $RestartTime <= $Now ) { # if the time of day has already passed, then # the user must mean that time tomorrow dprint(32, "set_restart_time(): adding a day to RestartTime $RestartTime (unix seconds)"); $RestartTime += $OneDay; } } return ($RestartTime); } ## Courtesy of "Shoshana Abrass" ... ## ## USAGE: set_alarm (seconds) ## ## WHICH: Takes an absolute time value in unix seconds, and sets the alarm ## to go off at that time by subtracting $Now seconds. We want to use ## the same value of $Now that was used above in set_restart_time, ## because ## (1) we presume these functions are being called sequentially; ## (2) to calculate against one $Now and set against another ## doesn't make sense. ## sub set_alarm{ my ($RestartTime) = @_; # carp "Called set_alarm"; if ( $Now == 0 ) { $Now = time();} # This should never happen if ( $RestartTime <= $Now ) { # This should never happen, because the intention is that # set_restart_time should be called before set_alarm. # But just in case.... print "WARNING: setting restart alarm to zero\n"; alarm(0); } else { alarm ($RestartTime - $Now); } } ## ## doit() ## sub doit { $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'TERM'} = $SIG{'ALRM'} = $SIG{'HUP'} = 'default'; $Config_File = (defined $opt_config_file) ? $opt_config_file : $DEF_CONFIG_FILE; ## Read in the configuration file ## if ($opt_old_style_config) { @Config = read_old_config($Config_File); } else { @Config = read_config($Config_File); } ## Create a script based on the configuration file and command line options my $Watcher_Script = make_script; if (defined $opt_dump_script) { ## Just write the script to STDOUT or the value of $opt_dump_script and exit if ($opt_dump_script ne '') { open(DS,">$opt_dump_script") or die "$0: cannot write to $opt_dump_script: $!\n"; } else { open(DS,">-") or die "$0: cannot wrote to STDOUT: $!\n"; } print DS "### Watcher Script BEGIN ###\n"; print DS $Watcher_Script; print DS "### Watcher Script END ###\n"; close(DS); $Done = 1; } else { ## Write the script to a file and run it ## ## Write the script file ## my $script_file = defined($opt_script_dir) ? $opt_script_dir : $ENV{'HOME'}; $script_file .= "/.swatch_script.$$"; my $swatch_fh = new FileHandle $script_file, "w"; if (defined $swatch_fh) { $swatch_fh->print($Watcher_Script); $swatch_fh->close; ## Now fork and start monitoring ## FORK: { if ($pid = fork) { dprint(8, "doit(): pid = $pid"); foreach my $k (sort keys %SIG) { dprint(8, "doit(): a: $k => $SIG{$k}") if defined $SIG{$k}; } $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'TERM'} = 'terminate'; $SIG{'ALRM'} = $SIG{'HUP'} = 'restart'; foreach my $k (sort keys %SIG) { dprint(8, "doit(): b: $k => $SIG{$k}") if defined $SIG{$k}; } if ( defined $opt_restart_time ) { my $RestartTime = set_restart_time($opt_restart_time); print "Will restart at ", ctime($RestartTime); set_alarm ($RestartTime); } waitpid($pid, 0); alarm(0); if (defined $opt_daemon) { exit(0); } } elsif (defined $pid) { exec("$EXECUTABLE_NAME $script_file"); } elsif ($! =~ /No more processes/) { # EAGAIN, supposedly recoverable fork error sleep 5; redo FORK; } else { die "$Me: Can't fork: $!\n"; } } $Done = 1 if (not $Restart); # Restart set to 1 by restart() # unlink($script_file); } } } ### ### MAIN ### $Done = 0; $Restart = 0; while (!$Done) { parse_command_line; main::doit(); } ### ### End of main block ### =head1 NAME swatch - simple watcher =head1 SYNOPSIS B [ B<--awk-field-syntax> ] [ B<--config-file|-c> I ] [ B<--daemon> ] [ B<--extra-include-dir|-I> I ] [ B<--extra-module|-M> I ] [ B<--help|-h> ] [ B<--input-record-separator> I ] [ B<--old-style-config|-O> ] [ B<--pid-file> I ] [ B<--restart-time|-r> I