storelog

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # storelog
   5 # File ID: 8044b360-3365-11e2-a80a-00c0a8deee11
   6 # [Description]
   7 #
   8 # Character set: UTF-8
   9 # ©opyleft 2012– Øyvind A. Holm <sunny@sunbase.org>
  10 # License: GNU General Public License version 2 or later, see end of
  11 # file for legal stuff.
  12 #=======================================================================
  13
  14 use strict;
  15 use warnings;
  16 use Fcntl ':flock';
  17 use Getopt::Long;
  18 use Time::HiRes qw{ gettimeofday };
  19
  20 local $| = 1;
  21
  22 our $Debug = 0;
  23
  24 our %Std = (
  25
  26     'host' => `hostname`,
  27     'maxfiles' => 500,
  28
  29 );
  30 chomp($Std{'host'});
  31
  32 our %Opt = (
  33
  34     'debug' => 0,
  35     'force' => 0,
  36     'groupid' => '',
  37     'gzip' => 0,
  38     'help' => 0,
  39     'host' => $Std{'host'},
  40     'maxfiles' => $Std{'maxfiles'},
  41     'spec' => '',
  42     'userid' => '',
  43     'uuid' => 0,
  44     'verbose' => 0,
  45     'version' => 0,
  46     'where' => '',
  47
  48 );
  49 chomp($Opt{'host'});
  50
  51 our $progname = $0;
  52 $progname =~ s/^.*\/(.*?)$/$1/;
  53 our $VERSION = '0.00';
  54
  55 Getopt::Long::Configure('bundling');
  56 GetOptions(
  57
  58     'debug' => \$Opt{'debug'},
  59     'force' => \$Opt{'force'},
  60     'groupid|G=s' => \$Opt{'groupid'},
  61     'gzip|z' => \$Opt{'gzip'},
  62     'help|h' => \$Opt{'help'},
  63     'host|H=s' => \$Opt{'host'},
  64     'maxfiles|m=i' => \$Opt{'maxfiles'},
  65     'spec|s=s' => \$Opt{'spec'},
  66     'userid|U=s' => \$Opt{'userid'},
  67     'uuid|u' => \$Opt{'uuid'},
  68     'verbose|v+' => \$Opt{'verbose'},
  69     'version' => \$Opt{'version'},
  70     'where|w=s' => \$Opt{'where'},
  71
  72 ) || die("$progname: Option error. Use -h for help.\n");
  73
  74 $Opt{'debug'} && ($Debug = 1);
  75 $Opt{'help'} && usage(0);
  76 if ($Opt{'version'}) {
  77     print_version();
  78     exit(0);
  79 }
  80 defined($ARGV[0]) || die("$progname: Missing project name\n");
  81 if (length($Opt{'where'})) {
  82     $Opt{'where'} =~ /[^aeo]/ && die("$progname: $Opt{'where'}: Invalid character in -w/--where argument\n");
  83 }
  84
  85 my $project = $ARGV[0];
  86 msg(1, "\$project = '$project'");
  87
  88 my $host = $Opt{'host'};
  89 msg(1, "\$host = '$host'");
  90
  91 my $projdir = "$ENV{'HOME'}/annex/log/$project";
  92 msg(1, "\$projdir = '$projdir'");
  93
  94 my $hostdir = "$projdir/$host";
  95 msg(1, "\$hostdir = '$hostdir'");
  96
  97 my $specfile = "$projdir/.spec";
  98 if (!-e $specfile && !$Opt{'spec'}) {
  99     die("$progname: $specfile: File not found, initialise with -s\n");
 100 }
 101
 102 if (length($Opt{'spec'})) {
 103     if (-e $specfile && !$Opt{'force'}) {
 104         die("$progname: $specfile: File already exists, use --force to overwrite\n");
 105     } else {
 106         msg(0, "dirstruct = '" . dirstruct($Opt{'spec'}) . "'");
 107         msg(0, "logtempl = '" . logtempl($Opt{'spec'}));
 108         system("mkdir -p $hostdir"); # FIXME
 109         -d $hostdir || die("$progname: $hostdir: Directory still doesn't exist\n");
 110         open(my $specfp, '>', $specfile) or die("$progname: $specfile: Cannot create file: $!\n");
 111
 112         print_rc($specfp, 'groupid');
 113         print_rc($specfp, 'gzip');
 114         print_rc($specfp, 'maxfiles');
 115         print_rc($specfp, 'spec');
 116         print_rc($specfp, 'userid');
 117         print_rc($specfp, 'uuid');
 118         print_rc($specfp, 'where');
 119
 120         close($specfp);
 121     }
 122     exit(0);
 123 }
 124
 125 open(my $specfp, '<', $specfile) or die("$progname: $specfile: Cannot open file for read: $!\n");
 126
 127 my $spec = '';
 128 while (my $curr = <$specfp>) {
 129     chomp $curr;
 130
 131     $curr =~ /^groupid\s+(.*)$/ && ($Opt{'groupid'} = $1);
 132     $curr =~ /^gzip\s+(.*)$/ && ($Opt{'gzip'} = $1);
 133     $curr =~ /^maxfiles\s+(.*)$/ && ($Opt{'maxfiles'} = $1);
 134     $curr =~ /^spec\s+(.*)$/ && ($spec = $1);
 135     $curr =~ /^userid\s+(.*)$/ && ($Opt{'userid'} = $1);
 136     $curr =~ /^uuid\s+(.*)$/ && ($Opt{'uuid'} = $1);
 137     $curr =~ /^where\s+(.*)$/ && ($Opt{'where'} = $1);
 138
 139 }
 140 close($specfp);
 141
 142 msg(1, ".spec: groupid = '$Opt{'groupid'}'");
 143 msg(1, ".spec: gzip = '$Opt{'gzip'}'");
 144 msg(1, ".spec: maxfiles = '$Opt{'maxfiles'}'");
 145 msg(1, ".spec: spec = '$spec'");
 146 msg(1, ".spec: userid = '$Opt{'userid'}'");
 147 msg(1, ".spec: uuid = '$Opt{'uuid'}'");
 148 msg(1, ".spec: where = '$Opt{'where'}'");
 149
 150 my $templ = dirstruct($spec);
 151
 152 my $old = '';
 153 my $old_logfile = '';
 154 my $logfp;
 155
 156 while (my $entry = <STDIN>) {
 157     # {{{
 158     my ($Epoch, $Fract) = gettimeofday();
 159
 160     if ($Epoch ne $old) {
 161         my ($Sec, $Min, $Hour,
 162             $Day, $Mon, $Year,
 163             $Wday, $Yday,
 164             $is_dst) = gmtime($Epoch);
 165         $Year += 1900;
 166         $Mon = sprintf("%02u", $Mon + 1);
 167         $Hour = sprintf("%02u", $Hour);
 168         $Min = sprintf("%02u", $Min);
 169         $Sec = sprintf("%02u", $Sec);
 170
 171         my $filedate = $templ;
 172         $filedate =~ s/%Y/$Year/g;
 173         $filedate =~ s/%m/$Mon/g;
 174         $filedate =~ s/%d/$Day/g;
 175         $filedate =~ s/%H/$Hour/g;
 176         $filedate =~ s/%M/$Min/g;
 177         $filedate =~ s/%S/$Sec/g;
 178
 179         my $logfile = "$hostdir/${filedate}Z.$project.log";
 180         if ($logfile ne $old_logfile) {
 181             msg(2, "logfile ne old_logfile");
 182             my $logdir = $logfile;
 183             $logdir =~ s/^(.*)\/(.*?)$/$1/;
 184             -d $logdir || system("mkdir -p $logdir"); # FIXME
 185
 186             if (length($old_logfile)) {
 187                 close($logfp);
 188                 if ($Opt{'gzip'}) {
 189                     msg(1, "gzip $old_logfile");
 190                     system('gzip', '-S', '.tmpgz', $old_logfile);
 191                     rename("$old_logfile.tmpgz", "$old_logfile.gz")
 192                         or warn("$progname: $old_logfile.tmpgz: Cannot rename to *.gz: $!\n");
 193                 }
 194             }
 195             if (!-e $logfile) {
 196                 msg(1, "Create '$logfile'");
 197                 open($logfp, '>', $logfile) or die("$progname: $logfile: Cannot create file: $!\n");
 198                 flock($logfp, LOCK_EX) || die("$progname: $logfile: Cannot flock(): $!\n");
 199             } else {
 200                 msg(1, "Append to '$logfile'");
 201                 open($logfp, '+>>', $logfile) or die("$progname: $logfile: Cannot open file for append: $!\n");
 202                 flock($logfp, LOCK_EX) || die("$progname: $logfile: Cannot flock(): $!\n");
 203                 seek($logfp, 0, 2) || die("$progname: $logfile: Cannot seek() to EOF: $!\n");
 204             }
 205             if (length($Opt{'userid'})) {
 206                 msg(1, "chown $Opt{'userid'} $logfile");
 207                 system('chown', $Opt{'userid'}, $logfile);
 208             }
 209             if (length($Opt{'groupid'})) {
 210                 msg(1, "chgrp $Opt{'groupid'} $logfile");
 211                 system('chgrp', $Opt{'groupid'}, $logfile);
 212             }
 213             $old_logfile = $logfile;
 214         }
 215     }
 216     if ($Opt{'uuid'}) {
 217         my $uuid_str = `uuid`;
 218         chomp($uuid_str);
 219         $entry = "$uuid_str $entry";
 220     }
 221     print($logfp $entry);
 222     ($Opt{'where'} =~ /[ae]/) && print(STDERR $entry);
 223     ($Opt{'where'} =~ /[ao]/) && print(STDOUT $entry);
 224     $old = $Epoch;
 225     # }}}
 226 }
 227
 228 length($old_logfile) && close($logfp);
 229
 230 exit(0);
 231
 232 sub print_rc {
 233     # {{{
 234     my ($fp, $keyw) = @_;
 235     if (length($Opt{$keyw})) {
 236         msg(0, ".spec: $keyw $Opt{$keyw}");
 237         print($fp "$keyw $Opt{$keyw}\n");
 238     }
 239     return;
 240     # }}}
 241 } # print_rc()
 242
 243 sub logtempl {
 244     # {{{
 245     my $spec = shift;
 246     my $datedirs = dirstruct($spec);
 247     my $retval = "$hostdir/${datedirs}Z.$project.log";
 248     msg(2, "project in logtempl: '$project'");
 249     msg(2, "logtempl('$spec') = '$retval'");
 250     return($retval);
 251     # }}}
 252 } # logtempl()
 253
 254 sub dirstruct {
 255     # {{{
 256     my $gran = shift;
 257     msg(2, "dirstruct('$gran')'");
 258
 259     my $count;
 260     my $period;
 261     if ($gran =~ /^(\d+)\.(.*)$/) {
 262         $count = $1;
 263         $period = $2;
 264         $period =~ s/^(...).*/$1/;
 265     } else {
 266         die("$progname: $gran: Wrong --spec format.\n");
 267     }
 268     msg(2, "\$gran = '$gran'");
 269     msg(2, "\$count = '$count'");
 270     msg(2, "\$period = '$period'");
 271
 272     my $retval;
 273
 274     my %mult = (
 275         'yea' => 1,
 276         'mon' => 12,
 277         'wee' => 52,
 278         'day' => 365,
 279         'hou' => 365 * 24,
 280         'min' => 365 * 24 * 60,
 281         'sec' => 365 * 24 * 60 * 60,
 282     );
 283     my $pryear;
 284     defined($mult{"$period"}) || die("$progname: $period: Unknown period\n");
 285     $pryear = int($count * $mult{"$period"} / 60);
 286     msg(1, "\$pryear = '$pryear'");
 287
 288     my $maxfiles = $Opt{'maxfiles'};
 289     if ($pryear < $maxfiles) {
 290         $retval = '%Y';
 291     } elsif ($pryear < $maxfiles * $mult{'mon'}) {
 292         $retval = '%Y/%Y%m';
 293     } elsif ($pryear < $maxfiles * $mult{'day'}) {
 294         $retval = '%Y/%m/%Y%m%d';
 295     } elsif ($pryear < $maxfiles * $mult{'hou'}) {
 296         $retval = '%Y/%m/%d/%Y%m%dT%H';
 297     } elsif ($pryear < $maxfiles * $mult{'min'}) {
 298         $retval = '%Y/%m/%d/%H/%Y%m%dT%H%M';
 299     } else {
 300         $retval = '%Y/%m/%d/%H/%M/%Y%m%dT%H%M%S';
 301     }
 302
 303     msg(2, "dirstruct('$gran') returns '$retval'");
 304     return($retval);
 305
 306     # }}}
 307 } # dirstruct()
 308
 309 sub print_version {
 310     # Print program version {{{
 311     print("$progname v$VERSION\n");
 312     return;
 313     # }}}
 314 } # print_version()
 315
 316 sub usage {
 317     # Send the help message to stdout {{{
 318     my $Retval = shift;
 319
 320     if ($Opt{'verbose'}) {
 321         print("\n");
 322         print_version();
 323     }
 324     print(<<"END");
 325
 326 Usage: $progname [options] project_name
 327
 328 Options:
 329
 330   --force
 331     Force operation to run, overwrite spec file.
 332   -G X, --groupid X
 333     Set logfile groupid to X.
 334   -h, --help
 335     Show this help.
 336   -H X, --host X
 337     Specify as host X.
 338     Default: '$Std{'host'}'.
 339   -m X, --maxfiles X
 340     Store maximum X files per directory.
 341     Default: $Std{'maxfiles'}.
 342   -s X, --spec X
 343     Create directory structure, use specification X. Format: "x.y" where
 344     x is number of expected log entries, and y is a period. Example:
 345       100.day - 100 entries per day
 346       1.sec - 1 entry per second
 347       20.week - 20 entries per week
 348     Only the first three letters are used. These periods are available:
 349       year, month, week, day, hour, minute, second,
 350       yea, mon, wee, day, hou, min, sec.
 351   -u, --uuid
 352     Prefix every logged line with time-based UUID (v1).
 353   -U X, --userid X
 354     Set logfile userid to X.
 355   -v, --verbose
 356     Increase level of verbosity. Can be repeated.
 357   -w X, --where X
 358     Send output to stdout and/or stderr. If X contains any of these letters:
 359       a - Send to both stdout and stderr
 360       e - Send to stderr
 361       o - Send to stdout
 362   -z, --gzip
 363     When a new file is created, compress the old one with gzip(1).
 364   --version
 365     Print version information.
 366   --debug
 367     Print debugging messages.
 368
 369 END
 370     exit($Retval);
 371     # }}}
 372 } # usage()
 373
 374 sub msg {
 375     # Print a status message to stderr based on verbosity level {{{
 376     my ($verbose_level, $Txt) = @_;
 377
 378     if ($Opt{'verbose'} >= $verbose_level) {
 379         print(STDERR "$progname: $Txt\n");
 380     }
 381     return;
 382     # }}}
 383 } # msg()
 384
 385 sub D {
 386     # Print a debugging message {{{
 387     $Debug || return;
 388     my @call_info = caller;
 389     chomp(my $Txt = shift);
 390     my $File = $call_info[1];
 391     $File =~ s#\\#/#g;
 392     $File =~ s#^.*/(.*?)$#$1#;
 393     print(STDERR "$File:$call_info[2] $$ $Txt\n");
 394     return('');
 395     # }}}
 396 } # D()
 397
 398 __END__
 399
 400 # Plain Old Documentation (POD) {{{
 401
 402 =pod
 403
 404 =head1 NAME
 405
 406
 407
 408 =head1 SYNOPSIS
 409
 410  [options] [file [files [...]]]
 411
 412 =head1 DESCRIPTION
 413
 414
 415
 416 =head1 OPTIONS
 417
 418 =over 4
 419
 420 =item B<-h>, B<--help>
 421
 422 Print a brief help summary.
 423
 424 =item B<-v>, B<--verbose>
 425
 426 Increase level of verbosity. Can be repeated.
 427
 428 =item B<--version>
 429
 430 Print version information.
 431
 432 =item B<--debug>
 433
 434 Print debugging messages.
 435
 436 =back
 437
 438 =head1 BUGS
 439
 440
 441
 442 =head1 AUTHOR
 443
 444 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
 445
 446 =head1 COPYRIGHT
 447
 448 Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
 449 This is free software; see the file F<COPYING> for legalese stuff.
 450
 451 =head1 LICENCE
 452
 453 This program is free software: you can redistribute it and/or modify it
 454 under the terms of the GNU General Public License as published by the
 455 Free Software Foundation, either version 2 of the License, or (at your
 456 option) any later version.
 457
 458 This program is distributed in the hope that it will be useful, but
 459 WITHOUT ANY WARRANTY; without even the implied warranty of
 460 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 461 See the GNU General Public License for more details.
 462
 463 You should have received a copy of the GNU General Public License along
 464 with this program.
 465 If not, see L<http://www.gnu.org/licenses/>.
 466
 467 =head1 SEE ALSO
 468
 469 =cut
 470
 471 # }}}
 472
 473 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :