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