1#!/usr/bin/perl 2# 3# $Id: rununpack.pl,v 4.10 1999/05/15 20:54:44 mj Exp $ 4# 5# Unpack ArcMail archives 6# 7# Usage: rununpack name 8# 9 10require 5.000; 11 12my $VERSION = '$Revision: 4.10 $ '; 13my $PROGRAM = "rununpack"; 14 15use strict; 16use vars qw($opt_v $opt_c); 17use Getopt::Std; 18use FileHandle; 19## commented due to problems with RedHat 5.0 and 5.1 20##use Sys::Syslog; 21 22# Common configuration for perl scripts 23<INCLUDE config.pl> 24 25my $BADDIR = "bad"; 26my $TMPDIR = "tmpunpack"; 27my $TMPOUT = "tmpunpack.out"; 28 29my @arc_bindirs; 30my %arc_l; 31my %arc_x; 32# Archiver programs configuration 33# %X is replaced with settings from toss.conf 34@arc_bindirs = ( "/bin", "/usr/bin", "/usr/local/bin", "%N"); 35# %a is replaced with archive file name 36$arc_l{"ARJ"} = "unarj l %a"; 37$arc_x{"ARJ"} = "unarj e %a"; 38$arc_l{"ARC"} = "arc l %a"; 39$arc_x{"ARC"} = "arc eo %a"; 40$arc_l{"ZIP"} = "unzip -l %a"; 41$arc_x{"ZIP"} = "unzip -ojL %a"; 42$arc_l{"RAR"} = "rar l %a"; 43$arc_x{"RAR"} = "rar e %a"; 44$arc_l{"LHA"} = "lha l %a"; 45$arc_x{"LHA"} = "lha eif %a"; 46$arc_l{"ZOO"} = "zoo l %a"; 47$arc_x{"ZOO"} = "zoo e: %a"; 48 49getopts('vc:'); 50 51# read config 52my $CONFIG = $opt_c ? $opt_c : "<CONFIG_MAIN>"; 53CONFIG_read($CONFIG); 54 55 56my $PRG = CONFIG_get("libdir"); 57my $SPOOL = CONFIG_get("spooldir"); 58my $OUTBOUND = CONFIG_get("btbasedir"); 59my $INBOUND = CONFIG_get("inbound"); 60my $PINBOUND = CONFIG_get("pinbound"); 61my $UUINBOUND = CONFIG_get("uuinbound"); 62my $FTPINBOUND = CONFIG_get("ftpinbound"); 63my $LOGFILE = CONFIG_get("logfile"); 64 65# syslog facility, level 66my $FACILITY = CONFIG_get("logfacility"); 67$FACILITY = "local0" if(!$FACILITY); 68my $LEVEL = CONFIG_get("loglevel"); 69$LEVEL = "notice" if(!$LEVEL); 70 71 72 73if($#ARGV != 0) { 74 die "usage: $PROGRAM NAME\n"; 75} 76my $NAME = $ARGV[0]; 77my $INPUT; 78 79# Set input and grade depending on NAME 80if ( $NAME eq "pin" ) { 81 $INPUT=$PINBOUND; 82} 83elsif( $NAME eq "in" ) { 84 $INPUT=$INBOUND; 85} 86elsif( $NAME eq "uuin" ) { 87 $INPUT=$UUINBOUND; 88} 89elsif( $NAME eq "ftpin") { 90 $INPUT=$FTPINBOUND; 91} 92elsif( $NAME =~ /^\/.+/ || $NAME =~ /^\.\/.+/ ) { 93 $INPUT=$NAME; 94} 95else { 96 die "$PROGRAM: unknown $NAME\n"; 97} 98 99(-d $INPUT) || die "$PROGRAM: $INPUT: no such directory\n"; 100 101 102 103##### Log message ############################################################ 104 105my @month = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 106 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' ); 107 108sub log { 109 my(@text) = @_; 110 local(*F); 111 my @x; 112 113 print "$PROGRAM @text\n" if($opt_v); 114 115 if($LOGFILE eq "syslog") { 116 # syslog logging 117## commented due to problems with RedHat 5.0 and 5.1 118## openlog($PROGRAM, 'pid', $FACILITY); 119## syslog($LEVEL, @text); 120## closelog(); 121 } else { 122 # write to log file 123 if($LOGFILE eq "stdout") { 124 open(F, ">&STDOUT") || die "$PROGRAM: can't open log $LOGFILE\n"; 125 } 126 elsif($LOGFILE eq "stderr") { 127 open(F, ">&STDERR") || die "$PROGRAM: can't open log $LOGFILE\n"; 128 } 129 else { 130 open(F, ">>$LOGFILE") || die "$PROGRAM: can't open log $LOGFILE\n"; 131 } 132 133 @x = localtime; 134 printf 135 F "%s %02d %02d:%02d:%02d ", 136 $month[$x[4]], $x[3], $x[2], $x[1], $x[0]; 137 print F "$PROGRAM @text\n"; 138 139 close(F); 140 } 141} 142 143 144 145##### Determine archive type ################################################# 146 147sub arc_type { 148 my($name) = @_; 149 local(*F); 150 my($buf, @b); 151 152 sysopen(F, "$name", 0) || die "$PROGRAM: error reading $name\n"; 153 sysread(F, $buf, 6); 154 @b = unpack("C6", $buf); 155 close(F); 156 157 return "ZIP" if($b[0]==ord('P') && $b[1]==ord('K') && $b[2]==3 &&$b[3]==4); 158 return "ARC" if($b[0]==26); 159 return "LHA" if($b[2]==ord('-') && $b[3]==ord('l') && $b[4]==ord('h')); 160 return "ZOO" if($b[0]==ord('Z') && $b[1]==ord('O') && $b[2]==ord('O')); 161 return "ARJ" if($b[0]==0x60 && $b[1]==0xea); 162 return "RAR" if($b[0]==ord('R') && $b[1]==ord('a') && $b[2]==ord('r')); 163 164 return "UNKNOWN"; 165} 166 167 168 169##### Run program ############################################################ 170 171my $status = 0; # Global status of last run_prog 172 173sub run_prog { 174 my($output, @args) = @_; 175 my($rc); 176 local(*SAVEOUT, *SAVEERR); 177 178 open(SAVEOUT, ">&STDOUT") || die "$PROGRAM: can't save STDOUT\n"; 179 open(SAVEERR, ">&STDERR") || die "$PROGRAM: can't save STDERR\n"; 180 open(STDOUT, ">$output") || die "$PROGRAM: can't open $output\n"; 181 open(STDERR, ">&STDOUT") || die "$PROGRAM: can't dup STDOUT\n"; 182 183 $rc = system @args; 184 $status = $rc >> 8; 185 186 close(STDOUT); 187 close(STDERR); 188 open(STDOUT, ">&SAVEOUT") || die "$PROGRAM: can't restore STDOUT\n"; 189 open(STDERR, ">&SAVEERR") || die "$PROGRAM: can't restore STDERR\n"; 190 191 print "Status $status\n" if($opt_v); 192 193 return $status == 0; 194} 195 196 197 198##### Run archive program #################################################### 199 200sub run_arc { 201 my($output, $cmd, $arc) = @_; 202 my($prog, @args, $i, $d); 203 204 $cmd =~ s/%a/$arc/g; 205 @args = split(' ', $cmd); 206 207 $prog = ""; 208 for $d (@arc_bindirs) { 209 $d = CONFIG_expand($d); 210 if(-x "$d/$args[0]") { 211 $prog = "$d/$args[0]"; 212 last; 213 } 214 } 215 return 0 if(!$prog); 216 217 $args[0] = $prog; 218 print "Run arc: @args\n" if($opt_v); 219 220 return run_prog($output, @args); 221} 222 223 224 225##### Main ################################################################### 226 227# Create necessary directories 228(-d "$INPUT/$BADDIR") || mkdir("$INPUT/$BADDIR", 0777); 229(-d "$INPUT/$TMPDIR") || mkdir("$INPUT/$TMPDIR", 0777); 230chdir("$INPUT/$TMPDIR") || die "$PROGRAM: can't chdir to $INPUT/$TMPDIR\n"; 231 232 233 234# Process mail archives in $INPUT 235my @files; 236opendir(DIR, "$INPUT") || die "$PROGRAM: can't open $INPUT\n"; 237@files = grep(/\.(mo|tu|we|th|fr|sa|su).$/i, readdir(DIR)); 238closedir(DIR); 239 240my $arc; 241my $type; 242my $cmd_l; 243my $cmd_x; 244my $ok; 245my @xf; 246my $f; 247my $old; 248my $new; 249my $n; 250 251for $arc (@files) { 252 # Archive type 253 $type = arc_type("$INPUT/$arc"); 254 if($type eq "UNKNOWN") { 255 &log("unknown archive $INPUT/$arc, moving archive to $INPUT/$BADDIR"); 256 rename("$INPUT/$arc", "$INPUT/$BADDIR/$arc") 257 || die "$PROGRAM: can't rename $INPUT/$arc -> $INPUT/$BADDIR/$arc\n"; 258 next; 259 } 260 &log("archive $INPUT/$arc ($type)"); 261 262 # List/extract program 263 $cmd_l = $arc_l{$type}; 264 $cmd_x = $arc_x{$type}; 265 266 # Run list on archive, if it fails skip archive for now 267 $ok = run_arc("/dev/null", $cmd_l, "$INPUT/$arc"); 268 print "List arc returned OK\n" if($opt_v && $ok); 269 if(!$ok) { 270 &log("WARNING: skipping archive $INPUT/$arc"); 271 next; 272 } 273 274 # Extract archive 275 $ok = run_arc("$TMPOUT", $cmd_x, "$INPUT/$arc"); 276 print "Extract arc returned OK\n" if($opt_v && $ok); 277 if(!$ok) { 278 &log("ERROR: unpacking archive $INPUT/$arc failed"); 279 &log("ERROR: ouput of command $cmd_x:"); 280 open(F, "$TMPOUT") || die "$PROGRAM: can't open $TMPOUT\n"; 281 while(<F>) { 282 chop; 283 &log("ERROR: $_"); 284 } 285 close(F); 286 287# &log("ERROR: removing extracted files"); 288# opendir(DIR, "$INPUT/$TMPDIR") 289# || die "$PROGRAM: can't open $INPUT/$TMPDIR\n"; 290# @xf = grep(/[^.].*/, readdir(DIR)); 291# closedir(DIR); 292# unlink @xf || die "$PROGRAM: can't remove extracted files\n"; 293 294 &log("moving archive to $INPUT/$BADDIR"); 295 rename("$INPUT/$arc", "$INPUT/$BADDIR/$arc") 296 || die "$PROGRAM: can't rename $INPUT/$arc -> $INPUT/$BADDIR/$arc\n"; 297 next; 298 } 299 unlink($TMPOUT) || die "$PROGRAM: can't remove $TMPOUT\n"; 300 301 # Move extracted files to input directory 302 opendir(DIR, "$INPUT/$TMPDIR") 303 || die "$PROGRAM: can't open $INPUT/$TMPDIR\n"; 304 @xf = grep(/[^.].*/, readdir(DIR)); 305 closedir(DIR); 306 for $f (@xf) { 307 $old = "$INPUT/$TMPDIR/$f"; 308 $new = "$INPUT/$f"; 309 $n = 0; 310 while(-f $new) { 311 $n++; 312 $new = "$INPUT/$n.$f"; 313 } 314 &log("packet $f renamed to $n.$f") if($n); 315 rename($old, $new) || die "$PROGRAM: can't rename $old -> $new\n"; 316 } 317 318 # Remove archive 319 unlink("$INPUT/$arc") || die "$PROGRAM: can't remove $INPUT/$arc\n"; 320} 321 322exit 0; 323