#! /usr/pkg/bin/perl
eval 'exec /usr/pkg/bin/perl -S $0 ${1+"$@"}'
    if 0;

#                                                         -*- Perl -*-
# Copyright (c) 1997, 98, 2000, 01
#    Motoyuki Kasahara
#
# 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, 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.

#
# This program is a Perl package running on Perl 4.036 or later.
# The package provides routines to process command line options like
# as GNU getopt_long().
#
# Version:
#     2.0.2
#
# Interface:
#
#   &getopt_initialize(LIST)
#     Set a list of command line options and initialize internal data
#     for &getopt_long.
#     You must call the routine before calling &getopt_long.
#     Format of each element in the LIST is:
#
#         `CANONICAL-OPTION-NAME [ALIAS-OPTION-NAME...] ARGUMENT-FLAG'
#
#     CANONICAL-OPTION-NAME, ALIAS-OPTION-NAME and ARGUMENT-FLAG fields
#     are separated by spaces or tabs.
#
#     CANONICAL-OPTION-NAME and ALIAS-OPTION-NAME must be either a single
#     character option including preceding `-' (e.g. `-v'), or a long
#     name option including preceding `--' (e.g. `--version').  Whether
#     CANONICAL-OPTION-NAME is single character option or long name
#     option is not significant.
#
#     ARGUMENT-FLAG must be `no-argument', `required-argument' or 
#     `optional-argument'.  If it is set to `required-argument', the
#     option always takes an argument.  If set to `optional-argument',
#     an argument to the option is optional.
#
#     You can put a special element `+' or `-' at the first element in
#     LIST.  See `Details about Option Processing:' for details.
#     If succeeded to initialize, 1 is returned.  Otherwise 0 is
#     returned.
#
#   &getopt_long
#     Get a option name, and if exists, its argument of the leftmost
#     option in @ARGV.
#
#     An option name and its argument are returned as a list with two
#     elements; the first element is CANONICAL-OPTION-NAME of the option,
#     and second is its argument.
#     Upon return, the option and its argument are removed from @ARGV.
#     When you have already got all options in @ARGV, an empty list is
#     returned.  In this case, only non-option elements are left in
#     @ARGV.
#
#     When an error occurs, an error message is output to standard
#     error, and the option name in a returned list is set to `?'.
#
# Example:
#
#     &getopt_intialize('--help -h no-argument', '--version -v no-argument')
#         || die;
#
#     while (($name, $arg) = &getopt_long) {
#         die "For help, type \`$0 --help\'\n" if ($name eq '?');
#         $opts{$name} = $arg;
#     }
#
# Details about Option Processing:
#
#   * There are three processing modes:
#     1. PERMUTE
#        It permutes the contents of ARGV as it scans, so that all the
#        non-option ARGV-elements are at the end.  This mode is default.
#     2. REQUIRE_ORDER
#        It stops option processing when the first non-option is seen.
#        This mode is chosen if the environment variable POSIXLY_CORRECT
#        is defined, or the first element in the option list is `+'.
#     3. RETURN_IN_ORDER
#        It describes each non-option ARGV-element as if it were the
#        argument of an option with an empty name.
#        This mode is chosen if the first element in the option list is
#        `-'.
#
#   * An argument starting with `-' and not exactly `-', is a single
#     character option.
#     If the option takes an argument, it must be specified at just
#     behind the option name (e.g. `-f/tmp/file'), or at the next
#     ARGV-element of the option name (e.g. `-f /tmp/file').
#     If the option doesn't have an argument, other single character
#     options can be followed within an ARGV-element.  For example,
#     `-l -g -d' is identical to `-lgd'.
#     
#   * An argument starting with `--' and not exactly `--', is a long
#     name option.
#     If the option has an argument, it can be specified at behind the
#     option name preceded by `=' (e.g. `--option=argument'), or at the
#     next ARGV-element of the option name (e.g. `--option argument').
#     Long name options can be abbreviated as long as the abbreviation
#     is unique.
#
#   * The special argument `--' forces an end of option processing.
#

{
    package getopt_long;

    $initflag = 0;
    $REQUIRE_ORDER = 0;
    $PERMUTE = 1;
    $RETURN_IN_ORDER = 2;
}


#
# Initialize the internal data.
#
sub getopt_initialize {
    local(@fields);
    local($name, $flag, $canon);
    local($_);

    #
    # Determine odering.
    #
    if ($_[$[] eq '+') {
	$getopt_long'ordering = $getopt_long'REQUIRE_ORDER;
	shift(@_);
    } elsif ($_[$[] eq '-') {
	$getopt_long'ordering = $getopt_long'RETURN_IN_ORDER;
	shift(@_);
    } elsif (defined($ENV{'POSIXLY_CORRECT'})) {
	$getopt_long'ordering = $getopt_long'REQUIRE_ORDER;
    } else {
	$getopt_long'ordering = $getopt_long'PERMUTE;
    }

    #
    # Parse an option list.
    #
    %getopt_long'optnames = ();
    %getopt_long'argflags = ();

    foreach (@_) {
	@fields = split(/[ \t]+/, $_);
	if (@fields < 2) {
	    warn "$0: (getopt_initialize) too few fields \`$arg\'\n";
	    return 0;
	}
	$flag = pop(@fields);
	if ($flag ne 'no-argument' && $flag ne 'required-argument'
	    && $flag ne 'optional-argument') {
	    warn "$0: (getopt_initialize) invalid argument flag \`$flag\'\n";
	    return 0;
	}

	$canon = '';
	foreach $name (@fields) {
	    if ($name !~ /^-([^-]|-.+)$/) {
		warn "$0: (getopt_initialize) invalid option name \`$name\'\n";
		return 0;
	    } elsif (defined($getopt_long'optnames{$name})) {
		warn "$0: (getopt_initialize) redefined option \`$name\'\n";
		return 0;
	    }
	    $canon = $name if ($canon eq '');
	    $getopt_long'optnames{$name} = $canon;
	    $getopt_long'argflags{$name} = $flag;
	}
    }

    $getopt_long'endflag = 0;
    $getopt_long'shortrest = '';
    @getopt_long'nonopts = ();

    $getopt_long'initflag = 1;
}


#
# When it comes to the end of options, restore PERMUTEd non-option
# arguments to @ARGV.
#
sub getopt_end {
    $getopt_long'endflag = 1;
    unshift(@ARGV, @getopt_long'nonopts);
}


#
# Scan elements of @ARGV for getting an option.
#
sub getopt_long {
    local($name, $arg) = ('?', '');
    local($key, $pattern, $match_count, $ch);
    local($_);

    &getopt_initialize(@_) if (!$getopt_long'initflag);
    return () if ($getopt_long'endflag);

    #
    # Get next option argument.
    #
    if ($getopt_long'shortrest ne '') {
	$_ = '-'.$getopt_long'shortrest;
    } elsif (@ARGV == 0) {
	&getopt_end;
	return ();
    } elsif ($getopt_long'ordering == $getopt_long'PERMUTE) {
	while (0 < @ARGV && $ARGV[$[] !~ /^-./) {
	    push(@getopt_long'nonopts, shift(@ARGV));
	}
	if (@ARGV == 0) {
	    &getopt_end;
	    return ();
	}
	$_ = shift(@ARGV);
    } elsif ($getopt_long'ordering == $getopt_long'REQUIRE_ORDER) {
	$_ = shift(@ARGV);
	if (!/^-./) {
	    push(@getopt_long'nonopts, $_);
	    &getopt_end;
	    return ();
	}
    } else {
	# $getopt_long'ordering == RETURN_IN_ORDER
	$_ = shift(@ARGV);
    }

    #
    # Check the special argument `--'.
    # `--' indicates the end of the option list.
    #
    if ($_ eq '--' && $getopt_long'shortrest eq '') {
	#
	# `--' indicates the end of the option list.
	#
	&getopt_end;
	return ();
    }

    #
    # Check for long and short options.
    #
    if (/^(--[^=]+)/ && $getopt_long'shortrest eq '') {
	#
	# This is a long style option, which start with `--'.
	#
	$pattern = $1;
	if (defined($getopt_long'optnames{$pattern})) {
	    $name = $pattern;
	} else {
	    #
	    # The option `name' is not registered in `@optnames'.
	    # It may be an abbreviated
	    #
	    $match_count = 0;
	    foreach $key (keys(%getopt_long'optnames)) {
		if (index($key, $pattern) == 0) {
		    $name = $key;
		    $match_count++;
		}
	    }
	    if (2 <= $match_count) {
		warn "$0: option \`$_\' is ambiguous\n";
		return ('?', '');
	    } elsif ($match_count == 0) {
		warn "$0: unrecognized option \`$_\'\n";
		return ('?', '');
	    }
	}

	#
	# Check an argument to the option.
	#
	if ($getopt_long'argflags{$name} eq 'required-argument') {
	    if (/=(.*)$/) {
		$arg = $1;
	    } elsif (0 < @ARGV) {
		$arg = shift(@ARGV);
	    } else {
		warn "$0: option \`$_\' requires an argument\n";
		return ('?', '');
	    }
	} elsif ($getopt_long'argflags{$name} eq 'optional-argument') {
	    if (/=(.*)$/) {
		$arg = $1;
	    } elsif (0 < @ARGV && $ARGV[$[] !~ /^-./) {
		$arg = shift(@ARGV);
	    } else {
		$arg = '';
	    }
	} elsif (/=(.*)$/) {
	    warn "$0: option \`$name\' doesn't allow an argument\n";
	    return ('?', '');
	}
    } elsif (/^(-(.))(.*)/) {
	#
	# This is a short style option, which start with `-' (not `--').
	# Short options may be catinated (e.g. `-l -g' is equivalent to
	# `-lg').
	#
	($name, $ch, $getopt_long'shortrest) = ($1, $2, $3);

	if (defined($getopt_long'optnames{$name})) {
	    #
	    # The option `name' is found in `@optnames'.
	    # Check its argument.
	    #
	    if ($getopt_long'argflags{$name} eq 'required-argument') {
		if ($getopt_long'shortrest ne '') {
		    $arg = $getopt_long'shortrest;
		    $getopt_long'shortrest = '';
		} elsif (0 < @ARGV) {
		    $arg = shift(@ARGV);
		} else {
		    # 1003.2 specifies the format of this message.
		    warn "$0: option requires an argument -- $ch\n";
		    return ('?', '');
		}
	    } elsif ($getopt_long'argflags{$name} eq 'optional-argument') {
		if ($getopt_long'shortrest ne '') {
		    $arg = $getopt_long'shortrest;
		    $getopt_long'shortrest = '';
		} elsif (0 < @ARGV && $ARGV[$[] !~ /^-./) {
		    $arg = shift(@ARGV);
		} else {
		    $arg = '';
		}
	    }
	} else {
	    #
	    # This is an invalid option.
	    # 1003.2 specifies the format of this message.
	    #
	    if (defined($ENV{'POSIXLY_CORRECT'})) {
		warn "$0: illegal option -- $ch\n";
		return ('?', '');
	    } else {
		warn "$0: invalid option -- $ch\n";
		return ('?', '');
	    }
	}
    } else {
	#
	# This is a non-option argument.
	# Only RETURN_IN_ORDER falled into here.
	#
	return ('', $_);
    }

    return ($getopt_long'optnames{$name}, $arg);
}

1;
#                                                         -*- Perl -*-
# Copyright (c) 1997, 98, 99, 2000, 01
#    Motoyuki Kasahara
#
# 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, 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.
#

# Set output record separator to ' '.
$, = ' ';

# Set umask
umask(022);

# PATH
$ENV{'PATH'} = '/usr/pkg/bin:/usr/pkg/bin:/usr/bin:/bin';
$ENV{'PATH'} .= ':/usr/ucb' if (-d '/usr/ucb');

# Program name, program version and mailing address.
$program_name = 'ndtpdaily';
$program_version = '3.1.5';
$mailing_address = 'm-kasahr@sra.co.jp';

# `ndtpstat' command.
$ndtpstat = '/usr/pkg/libexec/ndtpstat';

# Log file.
$log_file = '/var/log/ndtpd.log';

# How many generataions of syslog files are kept.
$ages = 7;

# `commpress' and `gzip' Command.
$compress = 'compress';
$gzip = 'gzip';
$bzip2 = 'bzip2';
$gzip_options = '';

# How to compress old logs; `gzip', `compress', or `none'.
$compressor = 'none';

# Compression programs and suffixes they usually add to the filename.
%compressors = ('gzip',     '.gz',
		'bzip2',    '.bz2',
		'compress', '.Z',
		'none',     '');

# Command to send mail which accepts "-s subject" option.
$mailx = '/usr/bin/mailx';

# Whether to send a report mail or not.
$report_mail_flag = 1;

# Usage
$help_message = "Usage: $program_name [option...] mail-address...
Options:
  -a INTEGER  --ages INTEGER
                             keep INTEGER ages of old syslog files
                             (default: $ages)
  -c TYPE  --compressor TYPE
                             how to compress old syslog files; compress, gzip,
                             bzip2 or none (default: $compressor)
  -h  --help                 display this help, then exit
  -l FILE  --log-file FILE   specify a syslog file
                             (default: $log_file)
  -n  --no-mail              do not send report mail
  -v  --version              display version number, then exit
  -1  --fast                 compress faster when using gzip or bzip2
  -9  --best                 compress better when using gzip or bzip2

Arguemnts:
  mail-address               receipient of a report from $program_name.

Report bugs to $mailing_address.
";

# Copyright message.
$copyright = "Copyright (c) 1997, 98, 99, 2000, 01
   Motoyuki Kasahara

This 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, 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.
";

# `try ...' message.
$try_help_message = "try \`$0 --help\' for more information\n";

# Command line options.
@long_options = ('-a --ages       required-argument',
		 '-c --compressor required-argument',
		 '-h --help       no-argument',
		 '-l --log-file   required-argument',
		 '-n --no-mail    no-argument',
		 '-v --version    no-argument',
		 '-1 --fast       no-argument',
		 '-2              no-argument',
		 '-3              no-argument',
		 '-4              no-argument',
		 '-5              no-argument',
		 '-6              no-argument',
		 '-7              no-argument',
		 '-8              no-argument',
		 '-9 --best       no-argument');

#
# Parse command line options.
#
&getopt_initialize(@long_options);
while (($option_name, $option_argument) = &getopt_long) {
    if ($option_name eq '-a') {
	if ($option_argument !~ /^\d+$/ || $option_argument <= 0) {
	    warn "$0: ages must be an integral number and greater than 0.\n";
	    exit(1);
	}
	$ages = $option_argument;
    } elsif ($option_name eq '-c') {
	if ($option_argument !~ /^(compress|gzip|bzip2|none)$/i) {
	    warn "$0: unknown compressor \`$option_argument\'\n";
	    warn $try_help_message;
	    exit(1);
	}
	$compressor = "\L$option_argument";
    } elsif ($option_name eq '-h') {
	print $help_message;
	exit(0);
    } elsif ($option_name eq '-l') {
	$log_file = $option_argument;
	
    } elsif ($option_name eq '-n') {
	$report_mail_flag = 0;
	
    } elsif ($option_name eq '-v') {
	print "$program_name (NDTPD) version $program_version\n";
	print $copyright;
	exit(0);
    } elsif ($option_name =~ /^-[1-9]$/) {
	$gzip_options = $option_argument;
    } else {
	warn $try_help_message;
	exit(1);
    }
}

if (@ARGV == 0) {
    warn "$0: too few argument\n";
    warn $try_help_message;
    exit(1);
}

die "$0: gzip not found.\n" if ($compressor eq 'gzip' && $gzip eq 'no');
die "$0: bzip2 not found.\n" if ($compressor eq 'bzip2' && $bzip2 eq 'no');

# 
# Set signal handlers. 
#
$SIG{'HUP'} = 'signal_handler';
$SIG{'INT'} = 'signal_handler';
$SIG{'QUIT'} = 'signal_handler';
$SIG{'TERM'} = 'signal_handler';

sub signal_handler {
    close(SAVEOUT);
    close(SAVEERR);
    if (-f $errfile && !unlink("$errfile")) {
	warn "$0: cannot unlink the file, $!: $errfile\n";
    }
    if (-f $statfile && !unlink("$statfile")) {
	warn "$0: cannot unlink the file, $!: $statfile\n";
    }
    exit(1);
}

#
# Redirect STDOUT and STDERR to temporary files.
#
$error_file = "/tmp/ndtpe$$";
$stat_file = "/tmp/ndtps$$";

if (-f $error_file && !unlink("$error_file")) {
    warn "$0: cannot unlink the file, $!: $error_file\n";
}
if (-f $stat_file && !unlink("$stat_file")) {
    warn "$0: cannot unlink the file, $!: $stat_file\n";
}

open(SAVEERR, ">&STDERR");
open(SAVEOUT, ">&STDOUT");
if (!open(STDERR, ">$error_file")) {
    print SAVEERR "cannot open the file $error_file, $!\n";
    exit 1;
}
if (!open(STDOUT, ">$stat_file")) {
    print SAVEERR "cannot open the file $stat_file, $!\n";
    exit 1;
}
select(STDOUT);
$| = 1;                      

#
# Get stat.
#
warn "failed to execute \`$ndtpstat $log_file\'\n"
    if (system("$ndtpstat $log_file") >> 8 != 0);

#
# Rotate old logs.
#
$suffix = $compressors{$compressor};
$i = $ages - 1;
warn "$0: cannot remove $log_file.$i$suffix\n"
    if (-f "$log_file.$i$suffix" && !unlink("$log_file.$i$suffix"));

while (0 < $i) {
    $j = $i--;
    warn "$0: cannot move $log_file.$i$suffix to $log_file.$j$suffix\n"
	if (-f "$log_file.$i$suffix"
	    && !rename("$log_file.$i$suffix", "$log_file.$j$suffix"));
}

warn "$0: cannot remove $log_file.0\n"
    if (-f "$log_file.0" && !unlink("$log_file.0"));

#
# Copy `ndtpd.log' to `ndtpd.log.0'.
#
warn "$0: failed to execute \`cp $log_file $log_file.0\'\n"
    if (system("cp $log_file $log_file.0") >> 8 != 0);

#
# Make a new log file.
#
warn "$0: cannot create new $log_file\n"
    unless (open(LOGFILE, ">$log_file") && close(LOGFILE));

#
# Compress the last log.
#
if ($compressor eq 'gzip') {
    if (system("$gzip $gzip_options $log_file.0") >> 8 != 0) {
	warn "$0: failed to execute \`$gzip $gzip_options $log_file.0\'\n";
    }
} elsif ($compressor eq 'bzip2') {
    if (system("$bzip2 $gzip_options $log_file.0") >> 8 != 0) {
	warn "$0: failed to execute \`$bzip2 $gzip_options $log_file.0\'\n";
    }
} elsif ($compressor eq 'compress') {
    # It doesn't examine exit code.  In some systems, `compress' returns
    # with exit code 1 when an file is larger after compression.  
    system("$compress -c $log_file.0 > $log_file.0$suffix");
    warn "$0: cannot compress $log_file.0\n" if (! -f "$log_file.0$suffix");
    warn "$0: cannot remove $log_file.0\n"
	if (-f "$log_file.0" && !unlink("$log_file.0"));
}

#
# Output log sizes.
#
print "Log Size:\n";
warn "$0: failed to execute \`ls -l $log_file*\'\n"
    if (system("ls -l $log_file*") >> 8 != 0);
print "\n\n\n";

#
# Error messages at executing ndtpdaily.
#
print "Error Messages at Executing $0:\n"
    if (-f $error_file && -s $error_file);

#
# Send the report via mail.
#
if ($report_mail_flag
    && system("cat $stat_file $error_file | $mailx -s \'ndtpd daily log\' @ARGV") >> 8 != 0) {
    print SAVEERR "failed to execute \`$mailx -s ... @ARGV\'\n";
    exit 1;
}

#
# Remove temorary files.
#
unlink($stat_file, $error_file);

exit;

# Local Variables: 
# mode: perl
# End: 
