contrib/archivegz.in

   1 #!/usr/bin/perl
   2 # Copyright 1999 Stephen M. Benoit, Service Providers of America.
   3 #  See notice at end of this file.
   4 #
   5 # Filename: archivegz.pl
   6 # Author: Stephen M. Benoit (benoits@servicepro.com)
   7 # Created: Wed Apr 14 13:56:01 1999
   8 # Version: $Id: archivegz.in 4329 2001-01-14 13:47:52Z rra $
   9 #
  10 $RCSID='$Id: archivegz.in 4329 2001-01-14 13:47:52Z rra $ ';
  11
  12 # Specify command line options, and decode the command line.
  13
  14 require 'newgetopt.pl';
  15 require 'newusage.pl';
  16 @opts =
  17   (
  18    "help|usage;;print this message",
  19    "version;;print version",
  20    "a=s;;directory to archive in instead of the default",
  21    "f;;directory names will be flattened out",
  22    "i=s;;append one line to the index file for each article (Destination name, Message ID, Subject)",
  23    "m;; Files are copied by making a link.  Not applicable, ignored",
  24    "r;;Suppress stderr redirection to /var/log/news/errlog",
  25    "n=s;;the news spool (source) directory (default=/var/spool/news/)",
  26    "t=i;;timeout that separates batches (default 10 seconds)",
  27    ";;input",
  28    # Examples.
  29    #
  30    # "OPT;;Option without an argument",
  31    # "OPT!;;Negatable option without an argument",
  32    # "VAR=T;;Option with mandatory argumet T = s(tring),i(nteger), or f(loat).
  33    # "VAR:T;;Option with optional argument.
  34    # "OPT|AAA|BBB";;AAA and BBB are aliases for OPT",
  35    # "VAR=T@";;Push option argument onto array @opt_VAR"
  36   );
  37 $ignorecase = 0;
  38 $badopt = !&NGetOpt(&NMkOpts(@opts));
  39 # $badarg = (@ARGV != 0);
  40 if ($badarg || $badopt || $opt_help)
  41   {
  42     &NUsage($0,0,'',@opts);
  43     exit ($badopt||$badarg);
  44   }
  45 if ($opt_version) {print STDERR "$RCSID\n"; exit 0}
  46
  47 # --------------------------------------------------------------------
  48
  49 # --- constants and defaults ---
  50 $NEWS_ROOT = "/var/spool/news/";
  51 $NEWS_ERR = "/var/log/news/errlog";
  52 $NEWS_ARCHIVE = $NEWS_ROOT . "news.archive/";
  53 $timeout = 10;
  54 if ($opt_t)
  55   { $timeout = $opt_t;}
  56 if ($timeout<1) {$timeout=1;}
  57
  58 # --------------------------------------------------------------------
  59
  60 sub regexp_escape
  61   {
  62     local($data)=@_;
  63
  64     $data =~ s+\\+\\\\+gi; # replace \ with \\
  65     $data =~ s+\/+\\\/+gi; # replace / with \/
  66
  67     $data =~ s/([\+\*\?\[\]\(\)\{\}\.\|])/\\$1/gi; # replace +*?[](){}.|
  68
  69     return $data;
  70   }
  71
  72 sub fhbits {
  73   local(@fhlist) = split(' ',$_[0]);
  74   local($bits);
  75   for (@fhlist) {
  76     vec($bits,fileno($_),1) = 1;
  77   }
  78   $bits;
  79 }
  80
  81 sub timed_getline
  82   {
  83     my ($fileh,$timeout)=@_;
  84     my $filehandle = (ref($fileh)
  85                       ? (ref($fileh) eq 'GLOB'
  86                          || UNIVERSAL::isa($fileh, 'GLOB')
  87                          || UNIVERSAL::isa($fileh, 'IO::Handle'))
  88                       : (ref(\$fileh) eq 'GLOB'));
  89     local(*FILEH) = *$fileh{FILEHANDLE};
  90
  91     local($rin,$win,$ein);
  92     local($rout,$wout,$eout);
  93     $rin = $win = $ein = '';
  94     $rin = fhbits('FILEH');
  95     $ein = $rin | $win;
  96     local($nfound);
  97     local($offset)=0;
  98     local($accum)='';
  99     local($done)=0;
 100     local($result);
 101
 102     $nfound = select($rout=$rin, $wout=$win, $eout=$ein, $timeout);
 103
 104     if ($nfound>0)
 105       {
 106
 107         # use sysread() to get characters up to end-of-line (incl.)
 108         while (!$done)
 109           {
 110             $result = sysread(FILEH, $accum, 1, $offset);
 111             if ($result<=0)
 112               {
 113                 $done=1;
 114                 return undef;
 115               }
 116
 117             if (substr($accum,$offset,1) eq "\n")
 118               {
 119                 $done=1;
 120               }
 121             else
 122               {
 123                 $offset+=$result;
 124               }
 125           }
 126       }
 127     return $accum;
 128   }
 129
 130 # --------------------------------------------------------------------
 131
 132 # --- source spool directory ---
 133 if ($opt_n)
 134   {
 135     if ($opt_n !~ /^\//) # absolute path?
 136       { $opt_n = $NEWS_ROOT . $opt_n; }
 137     if ($opt_n !~ /\/$/) # must end with /
 138       { $opt_n .= '/'; }
 139     $NEWS_ROOT = $opt_n;
 140   }
 141
 142 # --- archive directory ---
 143 if ($opt_a)
 144   {
 145     if ($opt_a !~ /^\//) # absolute path?
 146       { $opt_a = $NEWS_ROOT . $opt_a; }
 147     if ($opt_a !~ /\/$/) # must end with /
 148       { $opt_a .= '/'; }
 149     $NEWS_ARCHIVE = $opt_a;
 150   }
 151
 152 # --- redirect stderr ---
 153 if (!$opt_r)
 154   {
 155     open(SAVEERR, ">&STDERR");
 156     open(STDERR, ">>$NEWS_ERR") || die "Can't redirect stderr";
 157   }
 158
 159 # --- get input file opened ---
 160 if ($infilename=shift(@ARGV))
 161   {
 162     if ($infilename !~ /^\//) # absolute filename?
 163       {
 164         $infilename = $NEWS_ROOT . $infilename;
 165       }
 166
 167   }
 168 else
 169   {
 170     $infilename="-";
 171   }
 172 open(INFILE,"<$infilename");
 173
 174 $done=0;
 175 while (!$done)
 176   {
 177     %sourcefile=();
 178     %destfile=();
 179     %destname=();
 180
 181
 182     # --- loop over each line in infile ---
 183     # comments start with '#', ignore blank lines, each line is a filename
 184     while ($srcfile = &timed_getline(INFILE,$timeout))
 185     {
 186       if ($srcfile =~ /\#/) {$srcfile = $`;}
 187       if ($srcfile =~ /^\s*/) {$srcfile = $';}
 188       if ($srcfile =~ /\s*$/) {$srcfile = $`;}
 189       if ($srcfile)  # if a filename survived all that...
 190         {
 191           if ($srcfile !~ /^\//) # absolute filename?
 192             {
 193               $srcfile = $NEWS_ROOT . $srcfile;
 194             }
 195           # $srcfile is now a valid, absolute filename
 196           # split filename into news directory, newsgroup and article number
 197           $artnum=-1;
 198           $remaining=$srcfile;
 199           if ($remaining =~ /\/(\d*)$/) # remove / and article number
 200             { $artnum = $1; $remaining=$`;}
 201           $regex = &regexp_escape($NEWS_ROOT);
 202           if ($remaining =~ /^$regex/) # split off news dir
 203             { $newsdir = $&; $grpdir = $';}
 204           else
 205             { $newsdir = ''; $grpdir = $remaining; } # ... otherwise, grp = dir
 206           $newsgrp = $grpdir;
 207           $newsgrp =~ s/\//\./g; # replace slash (/) with dot (.)
 208           if ($opt_f)
 209             {
 210               $grpdir = "$newsgrp.gz";
 211             }
 212           else
 213             { $grpdir .= "/archive.gz"; }
 214           $destfile = $NEWS_ARCHIVE . $grpdir;
 215
 216           # print STDERR "$srcfile --> $newsgrp --> $destfile\n";
 217           if ($sourcefile{$newsgrp}) {$sourcefile{$newsgrp} .= " ";}
 218           $sourcefile{$newsgrp} .= $srcfile;
 219           $destfile{$newsgrp} = $destfile;
 220           $destname{$newsgrp} = $grpdir;
 221         }
 222     }
 223
 224     # --- is there anything to do at this time? ---
 225     if (%destfile)
 226       {
 227
 228         # --- open INDEX ---
 229         if ($opt_i)
 230           {
 231             # make sure directory exists
 232             if ($opt_i =~ /\/[^\/]*$/)
 233               {
 234                 $dirbase=$`;
 235                 system("mkdir -p $dirbase");
 236               }
 237             open(INDEX,">>$opt_i");
 238           }
 239
 240         # --- make sure that archive file can be written (make parent dirs) ---
 241         if ($destfile{$group} =~ /\/[^\/]*$/)
 242           {
 243             $dirbase=$`;
 244             system("mkdir -p $dirbase");
 245           }
 246
 247         # --- process each article ---
 248         foreach $group (keys(%destfile))
 249           {
 250             # --- gzip the concatenated document, appending archive file ---
 251             open(GZIP, "|gzip -c >> $destfile{$group}") || die "Can't open gzip";
 252
 253             # --- concatenate the articles, keeping header info if needed ---
 254             @accum_headers=();
 255             foreach $srcfile (split(/\s+/, $sourcefile{$group}))
 256               {
 257                 # print STDERR "reading $srcfile...\n";
 258                 $this_doc='';
 259                 open(DOC, "<$srcfile");
 260                 while ($line=<DOC>)
 261                   {
 262                     $this_doc .= $line;
 263                   }
 264                 close(DOC);
 265                 print GZIP $this_doc;
 266                 if ($opt_i)
 267                   {
 268                     # --- get header information and store it in index
 269                     $subject=''; $mesageid=''; $destname='';
 270                     if ($this_doc =~ /Subject:\s*(.*)/)
 271                       { $subject = $1; }
 272                     if ($subject =~ /^\s*/) {$subject = $';}
 273                     if ($subject =~ /\s*$/) {$subject = $`;}
 274                     if ($this_doc =~ /Message-ID:\s*(.*)/)
 275                       {$messageid = $1; }
 276                     if ($messageid =~ /^\s*/) {$messageid = $';}
 277                     if ($messageid =~ /\s*$/) {$messageid = $`;}
 278
 279                     print INDEX "$destname{$group} $messageid $subject\n";
 280                   }
 281               }
 282
 283             close(GZIP);
 284           }
 285
 286         # --- close index file ---
 287         if ($opt_i)
 288           {
 289             close(INDEX);
 290           }
 291       }
 292
 293     if (!defined($srcfile)) # file was closed
 294       {
 295         $done=1;
 296         last;  # "break"
 297       }
 298
 299   }
 300
 301 # --- restore stderr ---
 302 if (!$opt_r)
 303   {
 304     close(STDERR);
 305     open(STDERR,">>&SAVEERR");
 306   }
 307
 308 # --- close input file ---
 309 close(INFILE);
 310
 311
 312 __END__
 313 # Local Variables:
 314 # mode: perl
 315 # End:
 316
 317 # Copyright 1999 Stephen M. Benoit, Service Providers of America (SPA).
 318 #
 319 # Permission to use, copy, modify, and distribute this software and its
 320 # documentation for any purpose without fee is hereby granted without fee,
 321 # provided that the above copyright notice appear in all copies and that both
 322 # that copyright notice and this permission notice appear in supporting
 323 # documentation, and that the name of SPA not be used in advertising or
 324 # publicity pertaining to distribution of the software without specific,
 325 # written prior permission.  SPA makes no representations about the
 326 # suitability of this software for any purpose.  It is provided "as is"
 327 # without express or implied warranty.
 328 #
 329 # SPA DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL
 330 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.  IN NO EVENT SHALL
 331 # SPA BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
 332 # DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
 333 # AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 334 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.