#!/usr/local/bin/perl # # DosAdmin -- Front-End for MS-DOS Incoming Files Test & Move # V1.6 pl 05 - 27 Feb 1999 # # # Written by # Jouko Valta (jopi@x2ftp.oulu.fi) # # Based on "msdosrecent", # written for x2ftp.oulu.fi by Jani "Flame/Pygmy Projects" Vaarala # # # Revision History # V1.0 pl 00 - 11 Jul 1996 # Checks for bad files, folds filenames, and strips box ads. # Scans .txt files to determine category, and dissolves .zip files. # to appropriate subdirectories. # # V1.1 pl 00 - 19 Jul 1996 # Create 00add -index file for each category dissolved. # Skip files newer than the preset minimum age (5 min). # # V1.2 pl 00 - 29 Aug 1996 # Added .ARC support # Added -help option. # Collect long description and use it if no 'Short:' specified. # Recursively dissolve any archives found inside archives. # Option to force dissolving to a specific directory instead. # Ensures correct group (ftpadm) for dissolved files. # # V1.3 pl 00 - 14 Oct 1996 # Enhanced duplicate handling methods. # Fixed bug in printing 'Short:' lines containing a '%'. # Create log of checked incoming files. # # V1.3 pl 01 - 18 Nov 1996 # Check that given Category is valid. # Several bug fixes in internal operation. (Oops!) # # V1.3 pl 02 - 31 Dec 1996 # Internal operation slightly developed. # Create ZIP comment file. # -scan and -bug options to allow debugging. # # V1.4 pl 00 - 17 Jan 1997 # All log files moved from /var/tmp to /pc/log. # Optionally evaluate archive contents while dissolving. # # V1.4 pl 01 - 12 Feb 1997 # Return values for functions declared. # Upon start, check current directory really is some FTP directory. # Check that Log Files are writeable. # File contents evaluation improved. # # V1.5 pl 00 - 21 Feb 1997 # Status Log File format 2.0. # Use Blacklist. # Strict (-S -U) options. # TXT files may have other extensions. # TXT parser accepts certain uppercase keywords and implied Category. # Create Keywords log. # Most of MOVE code written. # # V1.5 pl 01 - 4 Apr 1997 # Options for CD-ROM database control # MOVE cheks that file has been dissolved first. # Write file contents evaluation to the comments file. # Write Long Description file. # On dissolve, file type recognition enhanced. # # V1.5 pl 02 - 30 Apr 1997 # Dissolve all files that match the txtfile. # Dissolve files without any txtfile to notxt/. # Absolute directory path handling corrected on dissolve. # Check the 'Replaces:' field. # # V1.5 pl 03 - 23 May 1997 # Heavy debugging done. # Protected the scanner against binary format .DOC files. # Option to create text file if one is not provided. # # V1.5 pl 04 - 16 Jun 1997 # General debugging and improved messages. # # V1.5 pl 05 - 9 Aug 1997 # Scanner and Category solver debugging plus improved messages. # # V1.5 pl 06 - 27 Sep 1997 # Error in 'tr' command jammed the Scanner with CreateText mode. # Scanner debugging still continued. # LHA & Zoo Syntax corrections. # # V1.5 pl 07 - 31 Oct 1997 # ZIP Filename extraction fixed on Dissolve. # Improved processing messages. # # V1.6 pl 00 - 15 Nov 1997 # Write X2 Template to the original (or auto-created) textfile. # # V1.6 pl 01 - 26 Nov 1997 # Recursive dissolving routines re-structured. # Dissolve writes 00status file for each category. # # V1.6 pl 02 - 23 Feb 1998 # Minor patches to prevent 'tr -d' from jamming. # Smooth adjustments in logging Diagnostic Output. # # V1.6 pl 03 - 04 Apr 1998 # Registration forms recognized better. # # V1.6 pl 04 - 27 Apr 1998 # Parser did not set any error code for unrecognized category. # # V1.6 pl 05 - 27 Feb 1999 # "CDRom" Keyword changed to "CDRom Permission". # DOS-readable Status and Remark filenames. # Print all Remarks on a Collection file by option (default ON). # New Keyword variations added to scanner (Creator, Written by). # . # # # Future # Implement Move file with CD-ROM database updating # # # This script is a front-end which scans files in INCOMING and reports # their status. After virus check on PC, the counterpart of this script # will be used for moving each file onto place, and sending reports to # uploaders. # Most of the file testing and other processing is performed by other # programs, specificly developed for each task. # # $Usage = "\ Options:\ -h show help page and exit\ -bug quick: skip all tests (not recommended)\ -b do blacklist\ -B specify blacklist file\ -scan just test scan routines, don't move anything\ -t just test files, don't move anything\ -C,-cd update CD-ROM database. (default true on move)\ -f fold uppercase to lowercase, warn if file exists (Default)\ -F fold uppercase to lowercase, overwrite if older file exists\ -ascii,-g Filter out DOS Graphics (Default)\ -I Update index files only (dissolve files to /dev/null)\ -i Interactive Move and rm (Default)\ -k Update Keywords Database (Default)\ -K Rebuild Keywords Database\ -D force another Category to place extracted files onto\ -e evaluate extracted files types\ -x dissolve files under /pc/ for virus check on PC. (Default)\ -X force dissolve\ -m move files (interactive)\ -M force move files (interactive)\ -r replace old files (use: -f -r or -m -r) (Default)\ -all find File Updates automatically (enables -r)\ -S strict mode: Key Fields required.\ -U strict mode: process updates only.\ -T Scan text files only. No zip files checked.\ -p Pack archive remark files. (Default)\ -o change owner of each file\ -v verbose mode.\ -V verbose mode. Also affects subprocesses used.\ -W Specify alternate workdir.\ -nb no blacklist\ -nC don't remove old CD-ROM entries.\ -ne ignore filetypes on extract\ -nf no name folding\ -ng keep any DOS Graphics\ -ni Non-interactive Move and rm\ -nk Do not rebuild Keywords Database\ -np Suppress printing packed archive remark file.\ -nt don't test for archive integrity\ -nl,-nu don't scan any upload log files\ -nx no dissolving\ -nm no move (Default)\ -nr don't replace files\ -ns,-nz don't strip Zip Comments and ads\n\ Quick re-scan: -T -R -D (-nb) -nt -nr -nf -nl (-ns)\n\n"; # ----------------------------------------------------------------------------- # Filenames # $YEAR = `/bin/date +%y`; # Year in 2 digits. $PCWORK = "/pc/prg"; # Where to dissolve files #$PCWORK = "/tmp/debug"; # Where to dissolve files (debugging) # NOTE: all files in this dir are removed! $LOGHOME = "/pc/log"; if (! -d $LOGHOME || ! -w $LOGHOME) { printf STDERR "Cannot access $LOGHOME. Please, check the setting or run\n create_dosadm_logs script.\n"; $LOGHOME = "/var/tmp"; } $UPLOADLOG = $LOGHOME . "/uploadlog"; $STATUSFILE = $LOGHOME . "/status"; $NOTESLOG = $PCWORK . "/00status.txt"; $UPDATESLOG = $PCWORK . "/00updates.txt"; $GlobalCommentFile = $PCWORK . "/00remarks.txt"; $TESTLOG = $LOGHOME . "/dostestlog"; $KEYWORDLOG = $LOGHOME . "/keywords"; $BLACKLIST = $LOGHOME . "/blacklist"; # removed files not wanted again $REJECTLOG = $LOGHOME . "/rejected.$YEAR"; # $REJECTLOG = "/ftp-service/ftp/pub/msdos/programming/x2info/rejected.$YEAR"; $INDEXDIR = $LOGHOME . "/programming"; # Re-formatted TXT files. $REUPLOADDIR = "/ftp-service/ftp/incoming/msdos/reupload_these"; $HOLDDIR = $REUPLOADDIR; $TEXTDIR = "/src/txt"; $REJECTDIR = "/src/junk"; $FTPDIR = "/ftp-service/ftp/pub/msdos"; $FTP_INCOMING = "/ftp-service/ftp/pub/msdos/incoming"; $CDROMDIR = "/ftp-service/cdrom/pub/msdos/programming"; $BIN = "/ftp-service/bin/"; $ZIPTEST = $BIN . "ziptest"; $ZIPCOMMENT = $BIN . "zipcomment -i -b -sa -log $TESTLOG"; $UPDATE_INDEX = $BIN . "doit"; $UPLOADER = $BIN . "uploader -f -u"; $MAILTEST = $BIN . "validaddr"; $LOCATE = "/local/bin/locate"; $FIND = "/bin/find \. -type f -print | /bin/cut -c3-"; $UNARC = "/usr/local/bin/arc x "; $UNARJ = "/usr/local/bin/unarj e "; # 'x' fails on the demo version $UNLZH = "/usr/local/bin/lha "; $UNZIP = "/usr/local/bin/unzip -L "; # Target directory support $UNZOO = "/local/bin/zoo xd "; ### $UNRAR = "/pc/bin/rar200.exe"; # ----------------------------------------------------------------------------- # Declare Status Constants # $VS_NONE = 0; $VS_OK = 1; $VS_INFECTED = 2; $AS_NONE = 0; $AS_OK = 1; $AS_CORRUPT = 2; $AS_FORMAT = 3; $AS_TAMPER = 4; $DS_NONE = 0; # File Dissolve Modes $DS_DIS = 1; $DS_CLEAR = 2; $DS_NEW = 3; # Clear PCWORK and dissolve files $DS_COUNT = 4; $DS_SCAN = 8; ## Declare CDROM Constants $CD_NONE = 0; $CD_YES = 1; $CD_FREE = 2; $CD_NONPROFIT = 3; $CD_GPL = 4; $CD_DEMO = 5; # Demo version, not for CD $CD_PERM = 6; # Prior permission required $CD_NO = 7; $CD_CONFL = 8; # Claimed yes, but contents seem suspicious $CD_ASKED = 16; @CDPrefix = ( "", "ON_", "ON_", "ON_", "", "OFF_", "OFF_", "OFF_", "OFF_", "", "", "", "", "", "", "", "ASKED_" ); @CDString = ( "n/a", "Yes", "Yes", "Yes", "n/a", "No", "No", "No", "No", "n/a", "n/a", "n/a", "n/a", "n/a", "n/a", "n/a", "n/a" ); # Declare Return Values for Test Functions $BAD_FILE = -1; $BAD_FILETYPE = -2; $DOC_BINARY = -3; $NO_MAINFILE = -4; $NO_TXTFILE = -5; $KEYSMISSING = -6; $NO_CATEGORY = -7; $BAD_CATEGORY = -8; $BAD_CDVALUE = -9; $FILE_EXISTS = -10; # $E_NONE = 0; $FILE_OK = 0; # Same as $E_NONE $FILE_SKIP = 1; # was it moved ? $MAIN_IS_TXT = 2; # Move $FILE_MOVE = 4; $FILE_HOLD = 5; # re-upload requested $FILE_JUNK = 6; $AltCategory = ""; $rmopt = ""; $Debug = 0; # Currently no option provided. $TestMode = 0; $TestScan = 0; $Verbose = 2; $Blacklist = 1; $FoldNames = 1; # Try to fold filenames: 0= no, 1= yes, 2= Force $DosGraphics = 1; $Dissolve = $DS_DIS; $Move = 0; $CDupdate = 0; # Off, as we need it as a command flag. $DoReplace = 0; $Comments = 1; $Owner = 1; $TestIntegr = 1; $ScanLogs = 1; # 1 = update log, 2 = don't $Build_KWords = 1; $EvaluateFiletypes = 1; # Flag file types included $CreateText = 1; # Create text file if one is not provided. $AskMv = 1; $Strict = 0; # If set, process GOOD files only. $MaxDescLen = 512; # Max length of Short Description # ----------------------------------------------------------------------------- # set path # $home=$ENV{HOME} || die "No HOME, are you homeless?\n"; $user=`/usr/ucb/whoami` || die "You don't exist.\n"; chop $user; $cwd = `/bin/pwd`; chop $cwd; # print $cwd; ### process any FOO=bar switches eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift; ### Command line options while ($_ = $ARGV[0], /^-/) { shift; last if /^--$/; if (/^-h/) { print $Usage; exit 2; } elsif (/^-scan/) { $TestMode = 0; ++$TestScan; ++$EvaluateFiletypes; next; } elsif (/^-t/) { ++$TestMode; next; } # Only test files elsif (/^-bug/) { $Comments = 0; $FoldNames = 0; $DoReplace = 0; $ScanLogs = 0; $TestIntegr = 0; $PCWORK = "/pc/debug"; $STATUSFILE= $PCWORK . "/status"; # not same as "00status" ! $TESTLOG = $PCWORK . "/dostestlog"; next; } elsif (/^-b/) { ++$Blacklist; next; } elsif (/^-B/) { $BLACKLIST = $ARGV[0]; shift; next; } elsif (/^-C|^-cd/) { $CDupdate = 1; next; } # command for CD updating elsif (/^-D/) { $AltCategory = $ARGV[0]; shift; next; } elsif (/^-e/) { $EvaluateFiletypes = 1; } # flag file types included elsif (/^-f/) { $FoldNames = 1; next; } elsif (/^-F/) { $FoldNames = 2; next; } elsif (/^-ascii|^-g/) { $DosGraphics= 1; next; } # remove DOS graphics elsif (/^-i/) { $AskMv = 1; next; } elsif (/^-k/) { $Build_KWords = 1; next; } # update Keywords file elsif (/^-K/) { $Build_KWords = 2; next; } # rebuild Keywords file elsif (/^-x/) { $Dissolve = $DS_DIS; next; } # extract archives elsif (/^-X/) { $Dissolve = $DS_NEW; next; } elsif (/^-I/) { $Dissolve = $DS_COUNT; next; } # only update indexes elsif (/^-T/) { $Dissolve = $DS_SCAN; next; } # re-scan txt files elsif (/^-m/) { $Move = 1; next; } # move files (interactive) elsif (/^-M/) { $Move = 2; next; } # force move files elsif (/^-R/) { $CreateText= 1; next; } # Note: -R requires 'EvaluateFiletypes' set as well. elsif (/^-r/) { $DoReplace = 1; next; } elsif (/^-a/) { $DoReplace = 2; next; } # find updates on FTP elsif (/^-S/) { $Strict = 1; ++$Blacklist; next; } # key fields required elsif (/^-U/) { $Strict = 2; ++$Blacklist; next; } # process updates only elsif (/^-o/) { $Owner = 1; next; } # change owner upon move elsif (/^-q/) { $Verbose = 0; next; } # quiet mode elsif (/^-v/) { $Verbose = 1; next; } # verbose mode elsif (/^-V/) { $Verbose = 2; next; } elsif (/^-W/) { $PCWORK = $ARGV[0]; shift; # where to dissolve files if (! -d $PCWORK || ! -w $PCWORK) { printf STDERR "Cannot access work directory $PCWORK.\n"; exit 2; } $NOTESLOG = $PCWORK . "/00status"; $UPDATESLOG = $PCWORK . "/00updates"; next; } elsif (/^-p/) { $GlobalCommentFile = $ARGV[0]; shift; next; } elsif (/^-np/) { $GlobalCommentFile = ""; next; } elsif (/^-nb/) { $Blacklist = 0; next; } elsif (/^-nC/) { $CDupdate = 2; next; } # keep old CD-ROM entries elsif (/^-ne/) { $EvaluateFiletypes = 0; } # don't check file types elsif (/^-nf/) { $FoldNames = 0; next; } # no name folding elsif (/^-ng/) { $DosGraphics= 0; next; } # keep DOS graphics elsif (/^-ni/) { $AskMv = 0; $rmopt = ""; next; } elsif (/^-nk/) { $Build_KWords = 0; next; } # don't update Keywords elsif (/^-nl/) { $ScanLogs = 0; next; } # don't read xferlogs elsif (/^-nu/) { $ScanLogs = 2; next; } # don't update uploadlog elsif (/^-nm/) { $Move = 0; next; } # don't move files elsif (/^-nR/) { $CreateText= 0; next; } elsif (/^-nr/) { $DoReplace = 0; next; } # don't replace files elsif (/^-ns|^-nz/) { $Comments = 0; next; } # skip ZipComment stripper elsif (/^-nt/) { $TestIntegr= 0; next; } # no integrity testing elsif (/^-nx/) { $Dissolve = 0; next; } # no dissolving elsif (/^-/) { die "Unsupported argument near $_\n Stopped"; } } if ($TestMode) { # $FoldNames = 0; $Dissolve = 0; $Move = 0; $DoReplace = 0; } if ($TestScan) { # Note: This option disabled TestMode $TestIntegr = 0; $FoldNames = 0; $Comments = 0; $DoReplace = 0; # $ScanLogs = 0; } if ($AltCategory) { # User-specified override, i.e. for no *.txt's $err = check_dos_category($AltCategory); } (! ($cwd =~ /ftp|src|warez/) || ($cwd =~ /cdrom/)) && die "\nNot FTP path... where are you ? Panic stop.\n\n"; # print "Group ID $)\n"; @ChkMark = ( " ", "x", "2", "3", "4", "5", "6", "7", "8", "9" ); if ($Verbose) { printf ("\n Parameters\n"); printf ("\t[$ChkMark[$TestMode]] Test only\n"); printf ("\t[$ChkMark[$TestIntegr]] Test Archives\n"); printf ("\t[$ChkMark[$FoldNames]] Folding\n"); printf ("\t[$ChkMark[$Comments]] Comments\n"); printf ("\t[$ChkMark[$Dissolve]] Extract\n"); printf ("\t[$ChkMark[$Move]] Move\n"); printf ("\t[$ChkMark[$DoReplace]] Replace\n"); printf ("\t[$ChkMark[$ScanLogs]] Xferlogs\n"); printf ("\t[$ChkMark[$EvaluateFiletypes]] Scan Archive Contents\n\n"); printf ("\t[$ChkMark[$CreateText]] Create Text\n"); printf ("\t[$ChkMark[$Build_KWords]] Update Keywords\n"); printf ("\tLogFile\t\t$TESTLOG\n"); printf ("\tWorkDir\t\t$PCWORK/$AltCategory\n"); # Subdir can be empty. printf ("\n"); } # Check workspace exists stat($PCWORK); ( -d _ && -r _ && -w _ && -x _ ) || die "Cannot access $PCWORK. Stopped"; stat($INDEXDIR); ( -d _ && -r _ && -w _ && -x _ ) || die "Cannot access $INDEXDIR. Stopped"; stat($STATUSFILE); (! -e _ || (-r _ && -w _ )) || die "Cannot access $STATUSFILE. Stopped"; stat($TESTLOG); (! -e _ || (-r _ && -w _ )) || die "Cannot access $TESTLOG. Stopped"; stat($NOTESLOG); (! -e _ || (-r _ && -w _ )) || die "Cannot access $NOTESLOG. Stopped"; stat($BLACKLIST); (! -e _ || (-r _ && -w _ )) || die "Cannot access $BLACKLIST. Stopped"; stat($REJECTLOG); (! -e _ || (-r _ && -w _ )) || die "Cannot access $REJECTLOG. Stopped"; stat($KEYWORDLOG); (! -e _ || (-r _ && -w _ )) || die "Cannot access $KEYWORDLOG. Stopped"; # Clear Work Directory if any of the options -S -U -X is specified. if ($Strict || ($Dissolve & $DS_CLEAR)) { printf STDERR "\nCleaning work directory '$PCWORK/'.\n"; printf STDERR "/bin/rm -rf $STATUSFILE $NOTESLOG $UPDATESLOG $PCWORK/*\n"; system ("/bin/rm -rf $STATUSFILE $NOTESLOG $UPDATESLOG $PCWORK/*"); system ("/bin/touch $STATUSFILE $NOTESLOG $UPDATESLOG"); system ("/bin/chgrp ftpadm $STATUSFILE $NOTESLOG $UPDATESLOG"); chmod 0664, $STATUSFILE; chmod 0664, $NOTESLOG; chmod 0664, $UPDATESLOG; } # Keywords log file. if ($Build_KWords == 2) { printf STDERR "\nBuilding new Keywords Log '$KEYWORDLOG'.\n"; rename ($KEYWORDLOG, "$KEYWORDLOG.old"); system ("/bin/touch $KEYWORDLOG; chgrp ftpadm $KEYWORDLOG"); chmod 0664, $KEYWORDLOG; } # ----------------------------------------------------------------------------- # # Read the Blacklist prior to any file processing. # if ($Blacklist) { open (B, "$BLACKLIST") || die "Cannot read Blacklist file.\n"; while () { chop; # print $_; # View processing... if (/^\s*$|^!/) { next; } # Empty line or comment if (/^\s*(\S+)\s+(\S+)\s+(.+)$/) { $BlackUploader{$1} = $2; $BlackEntry{$1} = $3; next; } } # while close B; } # blacklist # ----------------------------------------------------------------------------- # Move files onto target directory # # List of checked files and their categories is obtained from STATUSFILE # if ($Move) { if (! $CDupdate) { $CDupdate = 1; # Update CD-Rom -- Not optional here. } $err = move_mainloop(); exit $err; } # Move # ----------------------------------------------------------------------------- if ($CDupdate) { (! $ARGV[0]) && die "Filename(s) to update must be specified.\n"; foreach $target (@ARGV) { # Check path, add if none given # /(\S+)[\/\\]([0-9A-Za-z_\+\-\~\^\$\|\!\%\*]+)/ # ($cat, $file) = ; if (! $path) { $path = $RealCategory; } # View processing... printf "\t%s\t%s\t%s\n", $cat, $file, $CDString[$cd]; $err = check_dos_category($cat); $err = update_cdrom($cat, $mainfile, $cd); } # foreach exit $err; } # CDupdate # ----------------------------------------------------------------------------- # ## Phase 1 Checking # # ----------------------------------------------------------------------------- # Test Files # Both the archive integrity is tested, and the mode looked up in xferlog. # # Three arrays are created. $Integrity{} for Ziptest results, and $BinMode{} # and $From{} for uploading records. Each array is indexed by the filename. # if ($ScanLogs) { $opt = ""; if ($ScanLogs == 2) { $opt = "-nw"; } # UPLOADER is a program that runs a case-insensitive 'grep' on the xferlogs. open (T, "$UPLOADER $opt incoming |") || die "Can't stat '$UPLOADER'. Stopped"; print STDERR "\nReading uploading logs...\n"; while () { # $Debug && print $_; # View processing... chop; # Note: All accesses are logged on the real directory, /pub/msdos/incoming/ # # /pub/msdos/incoming/pedit200.txt b 638 pb@vol * [Sat Mar 22 16:11:37 1997] # /pub/msdos/incoming/pedit200.zip b 105547 pb@vol * [Sat Mar 22 16:11:53 1997] # / file ascii size email realhost date if (/msdos\/incoming\S*\/(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\[.+\])/) { $BinMode{$1} = $2; # 'a' or 'b' $FileSize{$1} = $3; # size when uploaded $From{$1} = $4; # unofficial e-mail $RealHost{$1} = $5; # real host if different $UploadDate{$1} = $6; # upload date (ascii string) $Debug && print "DEBUG '$1'\t$BinMode{$1}\t$From{$1}\t$RealHost{$1}\t$UploadDate{$1}\n"; } } close T; } # ScanLogs if ($TestIntegr) { # Archive integrity testing (required) print STDERR "\nTesting archives\n"; # If there are filenames specified on command line, pass them trough. # Otherwise, test all files in the current working directory. open (T, "$ZIPTEST @ARGV |") || die "Can't open $ZIPTEST"; while () { print $_; # View processing... if (/^\s*ok\s+(\S+)/) { $Integrity{$1} = 1; next; } if (/^\s*ERROR\s+(\S+)/) { $Integrity{$1} = -1; next; } } close T; } # Integrity # ----------------------------------------------------------------------------- # # Create lookup table for old files # # Scan subdirectories (reupload, old_upload) for duplicates and build # lookup-table for old files. if ($DoReplace) { $ROOTDIR = "/ftp-service"; # Work Dir to chdir to $FTPDIRS = "ftp/pub/msdos"; $FIND_FTP = "/bin/find $FTPDIRS -type f -print"; printf "\n\nCreating lookup table for files on the FTP Archive.\n"; open (foo, "$FIND_FTP |") || printf "Can't excute '$FIND_FTP'"; while () { chop; if (/^\s*$/) { next; } # Empty line elsif (/incoming\//) { next; } # Incoming directory # Takes the last slash by default. elsif (/ftp\/(\S+)\/(\S+)/) { # File in any FTP dir $dir = $1; $file = $2; # $index= $dir ."/" . $file; $FileTable{$file} .= "$dir "; # Add path found } } # while while (<"$REUPLOADDIR/*">) { if (/reupload_these\/(\S+)$/) { # filename # print "re-requested file '$_'"; # View processing... next; } } # while while (<"old_uploads/*">) { if (/old_uploads\/(\S+)$/) { # filename } } # while } # DoReplace # ----------------------------------------------------------------------------- # ## Initialize logging # # ----------------------------------------------------------------------------- # The log files will be cleared by option, or via removing releated lines when # sending the final upload report. open (L, ">> $TESTLOG") || die "Cannot open Test Log file. Stopped"; open (N, ">> $NOTESLOG") || die "Cannot open Check Log file. Stopped"; open (R, ">> $REJECTLOG") || die "Cannot open Reject Log file. Stopped"; # File Updates list open (U, ">>$UPDATESLOG") || printf "*** Cannot open Updates Log file.\n"; ## Scan any TXT,ZIP,LZH,ARJ Filenames if ($ARGV[0]) { open (foo, "/bin/ls -1 @ARGV |") || die "Can't list input files"; } else { open (foo, "$FIND |") || die "Can't open $FIND"; } $date = `/bin/date`; print L "\n\nRUN\t$cwd\t($user)\t$date\n"; # Easier to read the log file printf "\n"; print N "\nX2 FileScan Log\t\t\t$date"; # LF included in date string. print N "----------------------------------------------------------------------------\n"; print N "Status\tCDROM\tFTPdir\t\tFile\t\tKeywords [ Source ]\n"; print N "----------------------------------------------------------------------------\n\n"; # ----------------------------------------------------------------------------- # ## Phase 2 Pruning # # ----------------------------------------------------------------------------- # # This loop checks each filename in the current directory, and folds them into # lowercase when needed. Then an attempt is made to replace corrupt files with # good ones. Succesfull opparation is flagged thus. Upon failure, request to # reupload the file is flagged. # printf "\nSorting out files\n"; $FileCount = 0; name: while () { chop; if (/^\s*$/) { next line; } # Empty line if (/README.UPL|^00|\/00/) { next; } # Don't touch the instructions if (/junk|txt\/|reupload/) { next; } # Ignore rejected files # File types known: # \.arc|\.arj|\.asm|\.lha|\.lzh|\.txt|\.com|\.doc|\.exe|\.lsm|\.nfo|\.diz| # \.readme|\.pas|\.c|\.h|\.zip|\.zoo @statit = stat $_; # $size = $statit[7]; # ( / 1024)+1; $mtime = $statit[9]; # Last modify time since the epoch # ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime($mtime); # Skip files that may still be written to... (default limit 5 min) if ((time - $mtime) < 300) { # 5*60 seconds print "Skip $_ (minimum age not reached)\n"; next name; } $file = $_; print "Checking $file\r"; # \r = CR, No linefeed # print "DEBUG $file\t$BinMode{$file}\t$From{$file}\t$RealHost{$file}\t$UploadDate{$file}\n"; # Fold filenames to lowercase if ($FoldNames) { $oldfile = $file; $file =~ y/A-Z\-\~\^\$\|\!\%\*/a-z________/; $file =~ s/[\.\_]good$|[\.\_]new$//gi; $file =~ s/\_\./\./g; # Check if folding is needed, and check no files will be overwritten # by accident. if ($file ne $oldfile) { @newstat = stat $_; # $newsize = $newstat[7]; # ( / 1024)+1; $newmtime = $newstat[9]; # Last modify time since the epoch # Protect 'newname' files that may still be written to... if ( $Integrity{$file} < 0 && (time - $newmtime) < 300) { # 5 min printf "Skip $oldfile ('$file' has not reached minimum age)\n"; $Integrity{$file} = 0; } # newname zero size if (! -e $file || -z $file ) { printf "Rename '$oldfile' => '$file'\n"; printf L "FOLD\t%s\t%s\n", $file, $oldfile; # Log name change rename_file ($oldfile, $file); } # old ok, newname fails elsif ($Integrity{$oldfile} > 0 && $Integrity{$file} < 0) { # 1 Tested OK. # 0 Not tested # -1 Test not passed. printf "Replacing defect '$file' with '$oldfile'\n"; printf L "REPL $file\t$oldfile\n"; # Log all operations rename_file ($oldfile, $file); } # old fails, newname either ok or fail # elsif ($Integrity{$oldfile} < 0 && $Integrity{$file} > 0) { elsif ($Integrity{$oldfile} < 0 ) { # 1 Tested OK. # 0 Not tested # -1 Test not passed. printf "Ignoring defect duplicate '$oldfile'\n"; printf L "RMDUP $file\t$oldfile\n"; # Log all operations printf ("rm $rmopt -- $oldfile\n"); system("rm $rmopt -- $oldfile"); } # files identical elsif (`diff $oldfile $file` == 0) { # 0 No differences were found. # 1 Differences were found. # >1 An error occurred. printf "Duplicate identical '$oldfile' <=> '$file'\n"; printf L "RMDUP $file\t$oldfile\n"; # Log all operations printf ("rm -- $oldfile\n"); system("rm -- $oldfile"); } # both ok, but files differ else { # if ($FoldNames == 2) # Force printf "***Files '$oldfile' and '$file' differ.\n"; } } # name differs (case-sensitively) } # Folding # --------------------------------------------------------------------- # Check BLACKLIST and REJECTDIR # These are checked before requesting a re-upload... if ($Blacklist) { if ($BlackEntry{$file}) { printf "*** $file is on Blaclist.\n"; printf "$file\t$BlackEntry{$file}\n"; printf N "BLACK\t$file\t$BlackEntry{$file}\n"; } if (-e "$REJECTDIR/$file") { printf "*** $file has been rejected once.\n"; printf "$file\t$BlackEntry{$file}\n"; printf "$file\t$BlackUploader{$file}\n"; printf N "JUNK\t$file\t$BlackUploader{$file}\n"; } # junk ($src, $mainfile, $txtfile, $REJECTDIR); # if ( ) { # add_blacklist ($file, $Uploader); # } } # Blacklist # --------------------------------------------------------------------- # Filter out bad files. (Executed always.) # # Running this program on reupload_these directory cannot affect the # files, because they won't pass the integrity test. # # First, filter out empty or bad copies and try to replace them. # Request for reupload if no valid file available, or autojunk it if # no uploader known. if ((! -s $file) || $Integrity{$file} < 0) { printf(STDERR"\nDetected bad file $file\n"); print ("rename ($file, $REUPLOADDIR/$file);\n"); rename ($file, "$REUPLOADDIR/$file"); # move txt file # $t = get_txt_name($file, 0); # rename ($t, "$REUPLOADDIR/$t"); # Log the file as "on hold" write_keys ($file, -1); # Log key fields printf L "HOLD\t%s\t%d\n", $file, $Integrity{$file}; printf N "HOLD\t%s\t%d\n", $file, $Integrity{$file}; next name; } # bad # --------------------------------------------------------------------- # Do Logs # printf L "STAT\t$file\t$size\n"; # --------------------------------------------------------------------- if ($DoReplace) { # Scan subdirectories (reupload, old_upload) for duplicates. # However, do not remove .txt on .zip, and vice versa. if ($FileTable{$file}) { # while (<"$REUPLOADDIR/$file*">) if (/reupload_these\/(\S+)$/) { # filename print "*** replace re-requested file '$_' ***\n"; # print L "REPL $file\t$_\n"; # Log all operations # print L "REQ-OFF\t$_\n"; # Remove from requests # printf( "rm $rmopt -- $_"); # system( "rm $rmopt -- $_"); } } while (<"old_uploads/$file*">) { if (/old_uploads\/(\S+)$/) { # filename print "*** replace old file '$_' ***\n"; # print L "REPL $file\t$_\n"; # Log all operations # printf( "rm $rmopt -- $_"); # system( "rm $rmopt -- $_"); } } # if (`diff $oldfile $file` == 0) { # 0 No differences were found. # 1 Differences were found. # >1 An error occurred. # print "Duplicate identical '$oldfile' <=> '$file'\n"; # print L "RMDUP $file\t$oldfile\n"; # Log all operations # printf( "rm $rmopt -- $oldfile"); # system( "rm $rmopt -- $oldfile"); # } } # DoReplace ++$FileCount; } # while PC file printf "\nTotal %d files.\n", $FileCount; close (L); chmod 0660, $TESTLOG; system ("chgrp -f ftpadm $TESTLOG"); # ----------------------------------------------------------------------------- # ## Phase 3 # # ----------------------------------------------------------------------------- # Weed out any garbage in the archives before going further with dissolving # them... # if ($Comments) { print STDERR "\nRunning ZipComment...\n"; # optional ZipComment parameters: # -t => -nd -nz # -V => -v # The rest ( -i -b -log ) are already defined on the variable. $op = ""; if ($TestMode) { $op = "-nd -nz"; } if ($Verbose == 2) { $op .= " -v"; } # If there are filenames specified on the command line, pass them trough. # Otherwise, test all files in the current working directory. # # Note: ARGV may not match when 'FoldNames' is set. system ("$ZIPCOMMENT $op @ARGV"); # kludge to make it interactive } # Comments # ----------------------------------------------------------------------------- # ## Phase 4 - Dissolve the files # # ----------------------------------------------------------------------------- # Finally, Dissolve the archives under $PCWORK/ or alternate directory # specified with -D option. # # Flag Value Action # 0 None # DS_DIS Dissolve files # DS_CLEAR Clear PCWORK. # DS_NEW Clear PCWORK and dissolve files. # DS_COUNT Extract Files to /dev/null # DS_SCAN Scan old text files, no mainfiles checked # # Re-open the test log file open (L, ">> $TESTLOG") || die "Cannot open Test Log file. Stopped"; if ($Dissolve) { $FileCount = 0; $ErrCount = 0; $ArcCount = 0; $TotalCount = 0; ## Scan any TXT,ZIP,LZH,ARJ Filenames # If there are filenames specified on the command line, pass them trough. # Otherwise, test all files in the current working directory. # # Note: ARGV may not match when 'FoldNames' is set. if ($ARGV[0]) { open (foo, "/bin/ls -1 @ARGV |") || die "Can't list input files"; } else { open (foo, "/bin/ls -1 *.* |") || die "Can't list input files"; } open (STF, ">>$STATUSFILE") || die "Cannot write Test Status file $STATUSFILE"; printf STF "\nCWD\t$cwd\t$date\n"; printf STF "REMARK\tCdRom\tcat\tmainfile\ttxtfile\n\n"; open (K, ">>$KEYWORDLOG") || die "Cannot write Keywords file $KEYWORDLOG"; # # Global Summary of Archives if ($GlobalCommentFile) { open (GLOBAL_CMT, ">$GlobalCommentFile"); } print "------------------------------------------------------------\n\n"; print "Extracting Files...\n"; while() { chop; # Scan .TXT file if (/\.txt|\.lsm|\.doc|\.diz|\.nfo|\.readme/i) { # $txtfile = $_; # $mainfile = &get_main_name($txtfile, 0); # printf "\n\n"; # Begin new file # # if (! $mainfile) { # printf STDERR "No mainfile for '$txtfile'. Skipping...\n"; # printf L "FAIL\t***\t\tNo mainfile for '$txtfile'.\n"; # printf N "FAIL\t\t***\t\tNo mainfile for '$txtfile'.\n"; # next; # } next; } # TXT file # The rest are assumed mainfiles. # The selection may be restricted via Strict option. if (/\.arc|\.arj|\.lha|\.lzh|\.zip|\.zoo|\.rar|\.exe|\.com/i || /\.asm|\.bas|\.pas|\.cc*$|\.hh*$|\.cpp|\.hpp|\.mod|\.s3m/i) { $mainfile = $_; $txtfile = get_txt_name($mainfile, 0); printf "\n\n"; # Begin new file # Handle Scan clear_records(); if ($txtfile) { scan_txt ($txtfile); } else { # printf STDERR "No textfile for '$mainfile'. Skipping...\n"; printf STDERR "No textfile for '$mainfile'.\n"; printf L "FAIL\t%s\t\tNo textfile found.\n", $mainfile; printf N "FAIL\t\t%s\t\tNo textfile found.\n", $mainfile; # next; $Category = "notxt"; $RealCategory = "notxt"; } # Force alternate Category if no primary one given. # This can be used when processing old FTP files. if ($AltCategory) { # User-specified override, for no *.txt's $Category = $AltCategory; $RealCategory = $AltCategory; } if (! $Source && $SourceList) { $Source = $SourceList; } # Validity Checking ... $err = check_records (); write_keys ($mainfile, 1); # Log key fields OK # Strict -- process good files only. if ($Strict) { if ($err != $FILE_OK || ($Strict == 2 && !$ReplaceList)) { printf "STRICT: '$mainfile': File skipped.\n"; $Debug && printf L "STRICT\t'$mainfile'\tFile skipped.\n"; DoError($DS_SCAN, $err); next; } } # strict if ($Dissolve != $DS_SCAN) { if (dissolve ($mainfile) < $E_NONE) { ++$ErrCount; DoError($Dissolve, $err); } # error # dissolve ($txtfile); # Move the .txt file } # Write Standardized Long Description file to the Database. write_long_txt ($RealCategory, $mainfile, $txtfile); # Write X2 Template to the original (or auto-created) textfile # if the keyword fields were not provided. if (!$txtfile || $err == $NO_TXTFILE || $err == $KEYSMISSING) { $tnam = "$FTP_INCOMING/$mainfile.tmp"; print "\n==> Creating $tnam (error $err)\n"; print L "CREATE\t$mainfile\tCreating '$tnam'\n"; write_form ($tnam); if (! open (LI, ">>$tnam")) { print "Cannot write $tnam"; print L "ERROR\t$mainfile\tCannot write $tnam"; } printf LI "\n----------------------------------------------------------------\n\n"; close LI; if ($txtfile) { system ("/bin/cat $txtfile >> $tnam"); rename $tnam, $txtfile; } else { system ("/bin/cat $FTP_INCOMING/$mainfile.txt-create >> $tnam"); ($n, $foo) = split (/\./, $mainfile, 2); $txtfile = $n . ".txt"; print "DEBUG: textfile = '$txtfile'"; rename $tnam, $txtfile; } # else chmod 0660, $txtfile; # Ensure permissions. } # Template ++$FileCount; $ArcCount += $IF_Archive; $TotalCount += $DisCount; } # file processed } # while close STF; # Statusfile for dissolved archives. # chmod 0664, $STATUSFILE; close K; # Sort Keywords system ("/bin/sort -u < $KEYWORDLOG > $KEYWORDLOG.new"); rename ("$KEYWORDLOG.new", $KEYWORDLOG); chmod 0664, $KEYWORDLOG; printf STDERR "\nCompleted.\n"; # Permissions if (($Dissolve & $DS_DIS)) { printf "\nDissolved %d files with %d errors.\n", $FileCount, $ErrCount; printf " Total %d Files, %d Nested archives.\n\n", $TotalCount, $ArcCount; printf L "\nREM\tDissolved %d files with %d errors.\n", $FileCount, $ErrCount; printf L "REM\tTotal %d Files, %d Nested archives.\n\n", $TotalCount, $ArcCount; if ($GlobalCommentFile) { close (GLOBAL_CMT); chmod 0660, "$GlobalCommentFile"; } printf STDERR "chgrp -Rf ftpadm $PCWORK\n"; system ("chgrp -Rf ftpadm $PCWORK"); system ("chmod -Rf g+rw $PCWORK"); } # File Dissolve mode } # if Dissolve option $date = `/bin/date`; print L "END\t$date"; # Easier to read the log file close L; close N; close R; close U; printf STDERR "Wrote Summary to $NOTESLOG.\n"; printf STDERR "done.\n"; exit 0; # ----------------------------------------------------------------------------- # *** End of Main Program *** # ----------------------------------------------------------------------------- # # sub rename_file { ($oldfile, $file) = @_; rename($oldfile, $file); $Integrity{$file} = $Integrity{$oldfile}; $BinMode{$file} = $BinMode{$oldfile}; $From{$file} = $From{$oldfile}; $FileSize{$file} = $FileSize{$oldfile}; # size when uploaded $RealHost{$file} = $RealHost{$oldfile}; $UploadDate{$file} = $UploadDate{$oldfile}; $OldName{$file} = $oldfile; } sub get_main_name { local ($txtfile, $seekflg) = @_; local $mainfile = ''; if ($txtfile =~ /(\S+)(\.txt|\.lsm|\.doc|\.nfo|\.readme)$/i) { # print "Search $txtfile => $1"; $hum = $1 . ".*"; while(<${hum}>) { if ($txtfile ne $_) { $mainfile = $_; } } if (!$mainfile && $seekflg) { # Search from TXTINDEX } # seek } # txtfile return $mainfile; } sub get_txt_name { local ($mainfile, $seekflg) = @_; local $txtfile = ''; ($hum, $foo) = split (/\./, $mainfile, 2); # print "\nSearch $mainfile => $hum"; if ($hum) { $hum .= ".*"; while(<${hum}>) { if (/(\S+\.)(txt|lsm|doc|diz|nfo|readme)$/i) { $txtfile = $_; } } if (!$txtfile && $seekflg) { # Search TEXTDIR } # seek } # hum return $txtfile; } # ----------------------------------------------------------------------------- sub DoError { local ($level, $errcode) = @_; printf L "ERROR\t%s\t proc %s error %s\n", $mainfile, $level, $errcode; printf N "ERROR\t%s\t proc %s error %s\n", $mainfile, $level, $errcode; printf NC "ERROR\t%s\t proc %s error %s\n", $mainfile, $level, $errcode; } # ----------------------------------------------------------------------------- # ## TXT File Handling Subroutines # # ----------------------------------------------------------------------------- sub clear_records { # Required or Automatic Fields. $Category = ""; $RealCategory = ""; $Source = ""; $SourceList = ""; $Creator = ""; $Author = ""; $Uploader = ""; # or Maintainer $Company = ""; $Short = ""; $Keywords = ""; $LongDescription = ""; $FormatsList = ""; # File Formats supported. $DocsList = ""; $Cdrom = ""; $CdromStatus = $CD_NONE; # Optional fields $Title = ""; $Version = ""; $EnterDate = ""; $Platforms = ""; $Requires = ""; $CopyingPolicy = ""; $ReplaceList = ""; $LineCount = 0; # Number of lines in LongDescr $PartNumber = 0; $PartCount = 0; # Number of parts in total. $LSMmode = 0; if ($EvaluateFiletypes) { # Flag file types included $IF_Readme = 0; $IF_Docs = 0; $IF_Miscinfo = 0; $IF_Source = 0; $IF_Exec = 0; $IF_Config = 0; # Program settings data $IF_Object = 0; $IF_Winapp = 0; $IF_Install = 0; $IF_Data = 0; # General data file $IF_Data_audio = 0; $IF_Data_image = 0; $IF_Archive = 0; $IF_System = 0; # Non-distributable files $IF_UnknownType = 0; $IF_PublicDomain= 0; $IF_Freeware = 0; $IF_Cardware = 0; $IF_Shareware = 0; $IF_Commercial = 0; $IF_Has_register= 0; # Anything with registration } # evaluate } # ----------------------------------------------------------------------------- # # Files affected # L TESTLOG log/dostestlog # N NOTESLOG work/00status # NC NCname work/cat/00status # R REJECTLOG log/rejected.xx # STF STATUSFILE log/status # sub write_keys { local ($file, $error) = @_; # $RealCategory on korjattu kategoria ja $Category uploadaajan antama. # Write Debug Log printf L "MODE\t%s\t%s\t%s\t%s\t%s\n", $file, $BinMode{$file}, $From{$file}, $RealHost{$file}, $UploadDate{$file}; printf L "MAIL\t%s\t%s\t%s\n", $file, $Uploader, $Author; printf L "SHORT\t%s\t%s\n", $file, $Short; printf L "SOURCE\t%s\t%s\n", $file, $Source; printf L "CATEGORY %s\t%s\t%s\n", $file, $RealCategory, $Category; $ReplaceList && printf L "REPLACE \t%s\t%s\n", $file, $ReplaceList; $Keywords && printf L "KEYWORDS\t%s\t%s\n", $file, $Keywords; if ($error < 0) { return; } # On success, store the fields. printf STF "MODE\t%s\t%s\t%s\t%s\t%s\n", $file, $BinMode{$file}, $From{$file}, $RealHost{$file}, $UploadDate{$file}; printf STF "MAIL\t%s\t%s\t%s\n", $file, $Uploader, $Author; printf STF "SHORT\t%s\t%s\n", $file, $Short; $Source && printf STF "SOURCE\t%s\t%s\n", $file, $Source; $ReplaceList && printf STF "REPLACE\t%s\t%s\n", $file, $ReplaceList; $Keywords && printf STF "KEYWORDS\t%s\t%s\n", $file, $Keywords; # Keyword Log $Keywords && printf K "%s/%s\t%s\n", $RealCategory, $file, $Keywords; # (Readable) File Status Log. # List any Updates, Auto-rejects and Notes. # Note: this is only performed for good files. if (! -d "$PCWORK/$RealCategory") { system ("mkdir $PCWORK/$RealCategory"); chmod 02770, "$PCWORK/$RealCategory"; } $NCname = "$PCWORK/$RealCategory/00status"; open (NC, ">>$NCname") || printf STDERR "Cannot write '$NCname'\n"; printf N "OK\t %s\t%-8s\t%8s\t%s %s [ %s ]\n", $CDString[$CdromStatus], $RealCategory, $file, $Title, $Keywords, $Source; printf NC "OK\t %s\t%-8s\t%8s\t%s %s [ %s ]\n", $CDString[$CdromStatus], $RealCategory, $file, $Title, $Keywords, $Source; if ($ReplaceList) { printf N "UPDATE\t%s\t%s\n", $RealCategory, $ReplaceList; printf NC "UPDATE\t%s\t%s\n", $RealCategory, $ReplaceList; printf U "UPDATE\t%s\t%s\n", $RealCategory, $ReplaceList; } close (NC); } # write_keys # ----------------------------------------------------------------------------- # Create new TXT or LSM file with long descriptions to use as source # for WWW index files. # # Don't bother sorting index modules by category. # sub write_long_txt { local ($cat, $mainfile, $txtfile) = @_; local $n, $txtpath; # $path = $INDEXDIR . "/" . get_category_path($cat); $path = $INDEXDIR; if (! -d $path) { return $BAD_CATEGORY; } if ($txtfile) { $txtpath = $path . "/" . $txtfile; } else { ($n, $foo) = split (/\./, $mainfile, 2); $txtpath = $path . "/" . $n . ".txt"; } # NOTE: 'textindex' and 'longindex.pl' expect .txt ot .lsm extensions only. write_form ($txtpath); chmod 0664, $txtpath; return 0; } # write_long_txt sub write_form { local ($txtpath, $foo) = @_; if (!open (LI, ">$txtpath")) { printf STDERR "Cannot write $txtpath\n"; printf L "ERROR\t$mainfile\tCannot write $txtpath\n"; return $BAD_FILE; } printf "Writing '$txtpath'\n"; # Write out the Standardized form # These entries will build up the 00longindex.txt files # If LSM file is given, copy the fields from it. # WAVGL.ASC # Title: Speech Research with WAVE-GL # [ Category: mxlibs ] # [ CDROM: no ] # Keywords: DrDobbs Nov96 C++ AUDIO WAV # # [ free format description ] # if ($LSMmode) { printf LI "Begin3\n"; } # printf LI "Category: %s\n", $Category; printf LI "Program: %s\n", $mainfile; printf LI "Title: %s\n", $Title; printf LI "Version: %s\n", $Version; ($LSMmode || $EnterDate) && printf LI "Entered-date: %s\n", $EnterDate; printf LI "Description: %s\n", $Short; printf LI "Keywords: %s\n", $Keywords; # --- # X2 Format additions printf LI "Source-code: %s\n", $Source; $FormatsList && printf LI "Formats: %s\n", $FormatsList; # --- printf LI "Author: %s\n", $Author; if ($LSMmode) { printf LI "Maintained-by: %s\n", $Uploader; # printf LI "Primary-site: %s\n", ""; # printf LI "Alternate-site: %s\n", ""; # printf LI "Original-site: %s\n", ""; } # LSM Format printf LI "Platforms: %s\n", $Platforms; $Requires && printf LI "Requires: %s\n", $Requires; printf LI "Copying-policy: %s\n", $CopyingPolicy; # printf LI "Replaces: %s\n", $ReplaceList; # printf LI "CDrom: %s\n", $Cdrom; ($LSMmode) && printf LI "End\n"; # Print Long Description if (! $LSMmode) { printf LI "\n---------------------------------------\n\n"; printf LI "%s\n", $LongDescription; } printf LI "\n"; close LI; return 0; } # write_form # ----------------------------------------------------------------------------- # Scan given .txt, .txt*, .nfo. or .readme file for specific keywords. # First the file given is searched for specific keywords. After that, # further tests are performed for text in free format without any keywords. # # Return Values # FILE_OK # NO_TXTFILE # DOC_BINARY # sub scan_txt { local ($txtfile, $foo) = @_; local $err = 0; printf "\n"; # Begin new file printf L "\n"; if (!$txtfile || !open (info, $txtfile)) { printf STDERR "***Can't open input file '$txtfile'\n"; printf L "FAIL\t$mainfile\tRead failed for '$txtfile': File not found.\n"; printf L "SCAN\t$mainfile\tFatal: No records found.\n"; printf L "SCAN\t$mainfile\t*** Parser giving up.\n"; return $NO_TXTFILE; } line: while () { ### Clean up non-ASCII ### if ($DosGraphics) { tr/\012\015\032\200-\377//d; # Remove DOS graphics } else { tr/\012\015\032//d; # chop CR LF and EOF } ### Protect the Scanner ### # Note: the hexcode trap may accept some real words as well. if (/^\s*$/) { next line; } elsif (/\000\000+/ || # /\xFF\xFF/ || # /^\s*[0-9A-Fa-f]{10,}\s*$/ || /^\s*\{\\rtf/i || # RTF file (.DOC) /WordDocument|W.o.r.d.D.o.c.u.m.e.n.t/) { # WORD file (.DOC) printf "*** SCANNER ABORTED ***\n"; printf L "SCAN\t%s\t[%s] Line %2d\t*** SCANNER ABORTED *** <<%s>>", $mainfile, $txtfile, $., $_; # '$.' is linecount return $DOC_BINARY; } # awe_help.doc # # 0000: d0 cf 11 e0 a1 b1 1a e1 00 00 00 00 00 00 00 00 ................ # 0010: 00 00 00 00 00 00 00 00 3e 00 03 00 fe ff 09 00 ........>....... # 0020: 06 00 00 00 00 00 00 00 00 00 00 00 06 00 00 00 ................ # 0030: 00 00 00 00 00 00 00 00 00 10 00 00 78 00 00 00 ............x... # 0040: 01 00 00 00 fe ff ff ff 00 00 00 00 01 00 00 00 ................ # 0050: 85 00 00 00 03 00 00 00 83 00 00 00 fb 00 00 00 ................ # 0060: 22 02 00 00 ff ff ff ff ff ff ff ff ff ff ff ff "............... # 0070: ff ff ff ff ff ff ff ff ff ff ff ff ff ff ff ff ................ # ... # 0200: 52 00 6f 00 6f 00 74 00 20 00 45 00 6e 00 74 00 R.o.o.t. .E.n.t. # 0210: 72 00 79 00 00 00 00 00 7e 06 00 00 1c 00 00 00 r.y.....~....... # ... # 04A0: 00 00 2f 60 2c 6b 01 20 03 61 6c 01 71 00 00 00 ../`,k. .al.q... # 04B0: 00 05 00 00 00 00 00 57 00 6f 00 72 00 64 00 44 .......W.o.r.d.D # 04C0: 00 6f 00 63 00 75 00 6d 00 65 00 6e 00 74 00 00 .o.c.u.m.e.n.t.. # 04D0: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ # # wgt/prv2_2.zip/pr/doc/prman.doc # #{\rtf1\ansi\ansicpg1252\uc1 \deff11\deflang1033\deflangfe1033{\fonttbl{\f0\froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f1\fswiss\fcharset0\fprq2{\*\panose 020b0604020202020204}Arial;} # ### Scan for Required fields ### # Short: or ^Summary: (news header) elsif (/^\s*\S?\s*Short\s*:\s*(.+)/i || /^Summary\s*:\s*(\S+)/) { $Short = $1; next line; } # Category: or Type: # Incorrect values like Shareware, Demo, etc are checked later. elsif (/^\s*Type\s*:\s*(.+)/i || /^\s*Cat[ae][cg]ory\s*:\s*(.+)/i) { $Category = $1; $Category =~ tr/A-Z/a-z/; if ($Category =~ /(\S+[\/\\]\S+)/) { # Weed out extra text $Category = $1; } ### print L "TYPE\t$mainfile\t$Category\n"; if (/\s*Cata[cg]ory/i) { printf L "SCAN\t$mainfile\tMalformed keyword, supposing 'Category'\n"; printf STDERR "***SCAN\t$mainfile\tMalformed keyword, supposing 'Category'\n"; } next line; } # CD-ROM -- CDrom Permission: (not case sensitive) # Check for sub-packages having different CD_ROM statuses. elsif (/^\s*\S?\s*CD[\-\ ]*ROM\s+Permission\s*:\s*(.+)\.*\s*$/i || /^\s*\S?\s*CD[\-\ ]*ROM\s*:\s*(.+)\.*\s*$/i || (/CD[\-\ ]*ROM/i && /permission/i && /\:\s*(.+)\.*\s*$/)) { ($Cdrom = $1) =~ tr/A-Z/a-z/; if ($CdromStatus != $CD_NONE) { printf "$mainfile:\tMultiple CD-ROM lines encountered.\n"; printf L "SCAN\t$mainfile\tMultiple CD-ROM lines encountered '$1'.\n"; } if ($Cdrom =~ /^yes/i || $Cdrom =~ /^sure/i) { $CdromStatus = $CD_YES; } elsif ($Cdrom =~ /^no/i || $Cdrom =~ /forbid/i) { $CdromStatus = $CD_NO; } elsif ($Cdrom =~ /prior|^written|require[ds]/i) { $CdromStatus = $CD_PERM; } else { print L "SCAN\t$mainfile\tUnknown or malformed CD-ROM status '$Cdrom'\n"; printf STDERR "***SCAN\t$mainfile\tUnknown or malformed CD-ROM status '$Cdrom'\n"; } next line; } ### Optional fields ### # Accept decorated formatting (? = Match 1 or 0 times). # elsif (/^\s*\S?\s*Filenames*\s*:\s*\(*\s*(.+)\s*\)*/i) { # $ = $1; # next line; # } elsif (/^\s*\S?\s*Part\s*:\s*(.+)/i) { $PartNumber = $1; next line; } elsif (/^\s*\S?\s*Repla[cs]es*\s*:\s*(.+)/i) { if (! ($1 =~ /^no\.*$|^none|^nothing\.?$/i)) { # Weed out 'no files' $ReplaceList .= $1 . " "; } next line; } elsif (/^\s*\S?\s*Sour*[cs]e\s*:\s*(.+)/i || /^\s*\S?\s*Sour*[cs]e[\-\s]*code\s*:\s*(.+)/i) { $Source = $1; if ($Source =~ /^no\.*$|^none/i) { $Source = "No src"; } next line; } elsif (/^\s*\S?\s*Formats?\s*:\s*(.+)/i) { $FormatsList = $1; next line; } # # 'Creator(s):' could be either the Author or some generator program. # But that's to be worried about later... elsif (/^\s*\S?\s*Creator\(?s?\)?\s*:\s*(.+)\s*/i) { $Creator = $1; next line; } # # ------------------------------------------------------------------- # ### Linux Software Map (LSM) fields ### ### Author(s) (not case sensitive). Multiple lines should be alloved. # 'Address:' may conflict with order/register forms. elsif (/^\s*\S?\s*Author\(?s?\)?\s*:\s*(.+)\s*/i || /^\s*\S?\s*Written\s+by\s*:?\s*(.+)\s*/i || /^\s*\S?\s*Contact\s*:\s*(.+)\s*/i || /^\s*\S?\s*Contact\s*Address\s*:\s*(.+)\s*/i || /^\s*\S?\s*E\-*mail\s*:?\s*(\S+)\s*/i || /\s+E\-*mail\s*:?\s*(\S+)\s*/i) { $tmp = $1; if ($tmp =~ /^-+|^_+/) { ++$IF_Has_register; ++$IF_Commercial; next; } if ($Author) { # Empty expected printf "$mainfile:\tMultiple Author lines encountered.\n"; printf L "SCAN\t$mainfile\tMultiple Author lines encountered '$tmp'.\n"; } # $Author .= &ParseAddress($tmp) . " "; $Author .= $tmp . " "; next line; } # Uploader: or ^From: (news header) elsif (/^\s*Uploader\s*:\s*(\S+)/i || /^From:\s*(\S+)/) { if ($Uploader) { # Empty expected printf "$mainfile:\tMultiple Uploader lines encountered.\n"; printf L "SCAN\t$mainfile\tMultiple Uploader lines encountered '$1'.\n"; } $Uploader = &ParseAddress($1); next line; } elsif (/^Begin3$/) { ++$LSMmode; # Flag on Linux Software Map mode. next line; } elsif (/^End$/ && $LSMmode) { $LSMmode = -1; # Flag done Linux Software Map mode. next line; } # # 'Name/nome' # 'Company/companhia' # 'Program/Programa' # 'Category/Categoria' # 'Author/Autor' # 'Requirements/Requerimentos' # elsif (/^\s*\S?\s*Title\s*:\s*(.+)/i || /^\s*\S?\s*Program\s*Name\s*:\s*(.+)/i) { $Title = $1; next line; } elsif (/^\s*\S?\s*File\s*:\s*(.+)/i || /^\s*\S?\s*Program\s*:\s*(.+)/i) { if (! $Title) { $Title = $1; } next line; } elsif (/^\s*\S?\s*Version\s*Number\s*:\s*V*\.*\s*(.+)/i || /^\s*\S?\s*Version\s*:?\s*V*\.*\s*(.+)/i) { $Version = " V " . $1; next line; } # For date, expect "year-mm-dd", "dd mm year", or "dd Mon(th) year". elsif (/^\s*\S?\s*Entered[\-\ ]Date\s*:\s*(.+)/i) { $EnterDate = $1; next line; } elsif (/^\s*\S?\s*Description\s*:\s*(.+)/i || /^\s*Content[\-\ ]Description\s*:\s*(.+)/i) { $Short = $1; next line; } elsif (/^\s*\S?\s*Keywords?\s*:\s*(.+)/i) { $Keywords = $1; next line; } elsif (/^\s*\S?\s*Maintained[\-\ ]By\s*:\s*(.+)/i) { $Uploader = &ParseAddress($1); next line; } # LSM Addresses elsif (/^\s*\S?\s*Primary[\-\ ][Ss]ites?\s*:\s*(\S+)/ || /^\s*\S?\s*Alternate[\-\ ][Ss]ites?\s*:\s*(\S+)/) { ($site = $1) =~ tr/A-Z/a-z/; if (!$Category && ($site =~ /^x2ftp/)) { ($Category = $site) =~ /(msdos[\/\\]\S+)/; printf STDERR "***DEBUG: LSM: got Category = $Category\n"; printf L "DEBUG: LSM: got Category = $Category\n"; } # x2ftp next line; } elsif (/^\s*\S?\s*Plata?forms?\s*:\s*(.+)/i) { $Platforms = $1; next line; } elsif (/^\s*\S?\s*Copying[\-\ ]Policy\s*:\s*(.+)/i) { $CopyingPolicy = $1; next line; } # 'Company' # 'Name' # 'Address' # 'Phone' # 'Fax' # 'Total' # 'Empfaenger' # 'Konto-Nummer' # 'Bankleitzahl' # 'Name' # 'Address' # # 'NAME' # 'STREET' # 'STATE' # 'TELEPHONE' # 'Signature' # Bank connection: # account number: # Order or Registering form ... elsif (/^\s*\S?\s*Registration\s*Form/i ||/^\s*\S?\s*Registration\s*key/i || /Users? Licence/i || /^\s*\S?\s*Payment\s*:\s*(.+)/i || /^\s*\S?\s*Name\s*:\s*(.+)/i || # Beware of program name /^\s*\S?\s*Phone\s*#?\s*:\s*(.+)/i || /^\s*\S?\s*Telephone\s*#?\s*:\s*(.+)/i || /^\s*\S?\s*Fax\s*#?\s*:\s*(.+)/i || /^\s*\S?\s*Company\s*:\s*(.+)/i || # /^\s*\S?\s*Address\s*:\s*(.+)/i) || # May be confused with Author /^\s*\S?\s*Street\s*:\s*(.+)/i || /^\s*\S?\s*City\s*:\s*(.+)/i || /^\s*\S?\s*City[,\/\s]State\s*:\s*(.+)/i || /^\s*\S?\s*State\s*:\s*(.+)/i || /^\s*\S?\s*State[,\/]*\s*ZIP\s*:\s*(.+)/i || /^\s*\S?\s*State[,\/]*\s*ZIP\s*Code\s*:\s*(.+)/i || /^\s*\S?\s*Signature\s*:\s*(.+)/i || /^\s*\S?\s*Country\s*:\s*(.+)/i) { ++$IF_Has_register; ++$IF_Commercial; next line; } print ">> $_\n"; # Mail Headers if (/^Subject:\s+(.+)\s*/) { $Title = $1; next line; } elsif (/^\s*\S?\s*Date\s*:\s+(.+)\s*/i) { $EnterDate = $1; next line; } elsif (/^To:\s+|^Content-[Tt]ype:\s+/) { next line; } ### Collect the Long Description. $LongDescription .= " $_"; ++$LineCount; ### Search some keywords in the text ... # FTP and WWW Addresses # NOTE: Beware of "other references" being interpreted as Category # declaration. if (/ftp:\/\/(\S+)/i || /http:\/\/(\S+)/i) { ($site = $1) =~ tr/A-Z/a-z/; if (!$Category && ($site =~ /^x2ftp/)) { ($Category = $site) =~ /(msdos[\/\\]\S+)/; printf STDERR "***DEBUG: LINK: got Category = $Category\n"; printf L "DEBUG: LINK: got Category = $Category\n"; } # x2ftp next line; } if (! $Category) { if (/(msdos[\/\\]programming[\/\\]\S+)/i) { $Category = $1; $Category =~ tr/A-Z/a-z/; printf STDERR "***DEBUG: FREE: got Category = $Category\n"; printf L "DEBUG: FREE: got Category = $Category\n"; } } # Category if (/Copyright\s+(.+)/i || /^\(C\)\s+(.+)/i || /\s+\(C\)\s+(.+)/i) { if (! $Author) { $Author = $1; } if (! $CopyingPolicy) { $CopyingPolicy .= "$_\n"; } } # Copyright # /(\S+) inc/i || /all rights reserved/i ### Copying Policy # GPL, BSD, Public Domain, Freeware, Cardware, Shareware, Copyright # register, fee, payment if (/[\$S]hareware/i) { ++$IF_Shareware; } # Ignore if (/^\s*Options\s*:/i || /^\s*Notes?\s*:/i || /^\s*Usage\s*:/i || /^\s*Appendix\s*:/i) { next; } # Flag Errors if (/^\s*(\S\S+)\s*:\s*(\S+)/) { printf STDERR "***SCAN: [%s]\tUnknown or malformed keyword '$1'\n\n", $txtfile; printf L "SCAN\t%s\t[%s:%2d]\tUnknown or malformed keyword '$1'\n", $mainfile, $txtfile, $.; # '$.' is linecount } } # while # ------------------------------------------------------------------------- # Final Cleaning. Clear variables that only contain whitespace. # if ($Short =~ /^\s*$/) { $Short = ""; } if ($Source =~ /^\s*$/) { $Source = ""; } if ($ReplaceList =~ /^\s*$/) { $ReplaceList = ""; } # Shrink spaces. Beware of things like 'C++', 'C--', 'http://', etc. printf STDERR "\nShrinking text...\n"; # Reduce: 2 or more Spaces, .... --- ~~ __ == || /// :: ** $$ !! $LongDescription =~ s/\s\s+|\.\.\.\.+|\-\-\-+|\~\~+|__+|==+|\|\|+|\/\/\/+|::+|\*\*+|\$\$+\!\!+/\ /gs; # Reduse: [ _ ~ * = | \ < > ] with any of [ + - _ ~ * = / | \ ! ] $LongDescription =~ s/[\_\~\*\=\|\\\<\>]\s*[\+\-\_\~\*\=\/\|\\\!]/\ /gs; $LongDescription =~ s/[\_\~\*\=\|\\\<\>]\s*[\+\-\_\~\*\=\/\|\\\!]/\ /gs; $LongDescription =~ s/[\+\-\_\~\*\=\/\|\\\<\>]\s+[\+\-\_\*\=\/\|\\]/\ /gs; $LongDescription =~ s/\s\s+|\s+\S(\s+\S)+\s+/\ /gs; # # 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 # $$$$$$$$g$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$g$$$$$$$$$$$$$ # $$$$$$$' `$$' `$$' `$$' $$$$ $$' `$$ `$' `$$$$$$$ # $$$$$$$ $$$$$$ $$$$$$$$ $$$$ $$ $$ $$ $$ $ $$$$$$$ # $$$$$$$ $ $$ $$$$$$ $$$$ $. $ $$ $$ $$ $ $$$$$$$ # $$$$$$$ $$ $$ $$$$$$$$ $$$$ $$$$ $$ $$ $$ $ $$$$$$$ # $$$$$$$, .$$, .$$$$ $$$$, $$$$ $$ $$ ,$ $$$$$$$ # $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ # # squeezed result: # # getmid15.zip g g ' ` ' ` ' ` ' ' ` `$' ` $ $ $. $ $ $ , . , . , ,$ if (!$Short) { if ($Title) { $Short = $Title . $Version; } else { # Cut Long Description to the max length of Short Description print L "SCAN\t$mainfile\tScan failed for '$txtfile': 'Short' record not found.\n"; $Short = substr($LongDescription, 0, $MaxDescLen); } } # Short if (!$Uploader) { print L "SCAN\t$mainfile\tScan failed for '$txtfile': 'Uploader' record not found.\n"; } # # These are not the same thing by definition. # E.g. 'Creator' could be just anything. # if (!$Author && $Creator) { $Author = $Creator; } if ($Author && $Uploader =~ /Author/i) { $Uploader = $Author; # Not equal by default } if (!$Cdrom) { print L "SCAN\t$mainfile\tScan failed for '$txtfile': 'CDrom' record not found.\n"; } close info; printf STDERR "Done Scan [$txtfile].\n\n"; return $FILE_OK; } # scan_txt # ----------------------------------------------------------------------------- # # Parse Values # # ----------------------------------------------------------------------------- # Try to figure out all possible ways to identify oneself. # Email address or LSM entry is expected, though. # sub ParseAddress { # local($n1, $n2) = @_; local $n1 = $_; # Formats: # addr@host Valid formats # addr@host (Real Name) # Real.Name@host (Real Name) # Real Name # Real Name # Real Name Invalid format # # Get address if (/\<*([A-Za-z0-9\.\_\-]+\@[A-Za-z0-9\.\_\-]+)\>*/) { $email = $1; } # Get realname if (/\(*(\S+[\.\s+].+)\)*\s+\<*/) { $name = $1; } if (! $email) { printf "***No e-mail address found.\n"; } # `validmail $1`; return ($email); } # ----------------------------------------------------------------------------- # sub check_replace { local ($file, $foo) = @_; local $path = ""; if (! $ReplaceList && $err == $KEYSMISSING) { # Try to locate any old version. $hum = $1 . ".*"; while(<${hum}>) { if ($file ne $_) { $rmlist .= "$_ "; } } } else { # Split ReplaceList line # split ( # foreach @tmp; # Check path, add if none given # /(\S+)[\/\\]([0-9A-Za-z_\-]+)/ if (! $path) { $path = $RealCategory; } } return $rmlist; } # check_replace # ----------------------------------------------------------------------------- # Return full pathname to FTP category. # Note: CD-ROM routines use check_cdrom_category instead. sub get_category_path { local ($cat, $foo) = @_; if ($cat =~ /arcers|virus/) { return $cat; } elsif ($cat =~ /programming/) { return $cat; } return "programming/$cat"; } # get_category_path # ----------------------------------------------------------------------------- # # Checking # # ----------------------------------------------------------------------------- sub check_records { local $err = 0; if (!$mainfile) { printf STDERR "\n***No mainfile for '$txtfile'. Skipping...\n"; return $NO_MAINFILE; } # Check that at least the required fields exist. if (!$Short || !$Category || !$Uploader || !$CdromStatus) { print L "SCAN\t$mainfile\tWarning: '$mainfile': Required fields missing.\n"; print L "FAIL\t$mainfile\tCannot move file.\n"; $err = $KEYSMISSING; } # Type or Category. First check if the value is not directory as expected. $err = check_dos_category($Category); $RealCategory = $cat; # Set to 'none' upon error. if ($err == $BAD_CATEGORY) { # if ($Category =~ /[\$S]hareware/i) { # } $Category = ""; # Clear incorrect value. } # Bad Category Value ### Joillekin tiedostoille Category menee kokonaan tyhjaksi, vaikka ### pitaisi olla "none". if (!$RealCategory && !$Category) { print L "SCAN\t$mainfile\tScan failed for '$txtfile': 'Category' record not found.\n"; # No Category given. Do some thinking... if ($Keywords) { $Category = "none"; if ($Keywords =~ /audio/) { $Category = "mxcode"; } elsif ($Keywords =~ /source/) { if ($Keywords =~ /game/) { $Category = "gamesrc"; } elsif ($Keywords =~ /demo/) { $Category = "demosrc"; } else { $Category = "source"; } } # source $RealCategory = $Category; } # Keywords else { $Category = "none"; $RealCategory = "none"; } # !Keywords } return $err; } # ----------------------------------------------------------------------------- # # Check given Category is valid ... # 'CHECKING' line starts a new file on the screen output. # # Returns the category in $cat # # Return Values # FILE_OK # NO_CATEGORY # BAD_CATEGORY # sub check_dos_category { local $err = $NO_CATEGORY; $cat = "none"; # No Category # Split the Category path. $p[0] = $p[1] = $p[2] = $p[3] = ""; ($path, $foo) = @_; if (!$path) { # Still failed print L "FAIL\t$mainfile\tNo Category specified.\n"; print "No Category specified for '$mainfile'.\n"; $path = "programming/unknown"; $cat = "none"; # No Category $err = $NO_CATEGORY; } else { @p = split (/\/|\\/, $path); # accept both / and \ (!$p[0]) && shift @p; ($p[0] eq "pub") && shift @p; ($p[0] eq "programming") && shift @p; # path in wrong order... ($p[0] eq "msdos") && shift @p; # Remove possible filename from the path. if ($p[2]) { $p[2] = ""; } elsif (!$p[2] && $p[1]) { $p[1] = ""; } # Check given Category is valid ... if ($p[0] =~ /^arcers?|^archivers?|^packers?/ && !$p[2]) { $cat = "arcers"; $err = $FILE_OK; } elsif (!$p[2] && ($p[0] eq "virus" || $p[0] eq "transfer")) { $cat = $p[0]; $err = $FILE_OK; } # It must be programming/something. Try both ways... # ignore missing "programming". elsif ($p[0] eq "programming" && $p[1] && !$p[2]) { $err = check_prg_category($p[1]); # Sets $cat } elsif ( !$p[1] && !$p[2]) { $err = check_prg_category($p[0]); } else { $err = $BAD_CATEGORY; } # Set $cat on success, else print error message. if ($err != $FILE_OK) { print L "FAIL\t$mainfile\tInvalid directory path '$path'\n"; print "Invalid Category '$path'\n"; # print ">>>'$p[0]'\t'$p[1]'\t'$p[2]'\n"; $cat = "none"; # Not valid Category } } # path return $err; } sub check_prg_category { local ($_, $foo) = @_; $cat = "none"; # Default if (!$_) { # Nothing given # $Category = "programming/unknown"; # print L "FAIL\t$mainfile\tNo Category specified.\n"; printf ("\n***No Category specified for '%s'.\n", $mainfile); return $NO_CATEGORY; } printf "\nChecking Category '$_'\n"; if (/^3dfx$/) { $cat = "3dfx"; } elsif (/^ack$/) { $cat = "ack"; } elsif (/^ai$/) { $cat = "ai"; } elsif (/^arts*$/) { $cat = "art"; } elsif (/^biz$/) { $cat = "biz"; } # books # Separate ftp area elsif (/^compress$|^pack$/) { $cat = "compress"; } elsif (/^contest\d*$/) { $cat = "contest"; } elsif (/^convert$/) { $cat = "convert"; } elsif (/^creative$/ ) { $cat = "creative"; } elsif (/^crypt$/) { $cat = "crypt"; } elsif (/^demosrcs?$/) { $cat = "demosrc"; } elsif (/^directx$/) { $cat = "directx"; } elsif (/^djgpp$/) { $cat = "djgpp"; } # No uploads on djgpp elsif (/^djgpp2$/) { $cat = "djgpp2"; } elsif (/^docs?$|^documents?$/){ $cat = "docs"; } elsif (/^faqs?$/) { $cat = "faq"; } elsif (/^fg$/) { $cat = "fg"; } elsif (/^formats?$/) { $cat = "formats"; } elsif (/^gamesrcs?$/) { $cat = "gamesrc"; } elsif (/^gdm$/) { $cat = "gdm"; } elsif (/^ghm$/) { $cat = "ghm"; } elsif (/^gpe$/) { $cat = "gpe"; } elsif (/^hardware$/) { $cat = "hardware"; } elsif (/^iguana$/) { $cat = "iguana"; } elsif (/^indeo$/) { $cat = "indeo"; } elsif (/^langs?$/) { $cat = "lang"; } elsif (/^libs?$/) { $cat = "libs"; } elsif (/^math$/) { $cat = "math"; } elsif (/^memory$/) { $cat = "memory"; } elsif (/^microsoft$/) { $cat = "microsoft"; } elsif (/^misc$/) { $cat = "misc"; } elsif (/^mxcode$/) { $cat = "mxcode"; } elsif (/^mxdata$/) { $cat = "mxdata"; } elsif (/^mxinfo$/) { $cat = "mxinfo"; } elsif (/^mxlibs?$/) { $cat = "mxlibs"; } elsif (/^mxutils?$/) { $cat = "mxutil"; } elsif (/^net$/) { $cat = "net"; } elsif (/^news$/) { $cat = "news"; } elsif (/^ng$/) { $cat = "ng"; } elsif (/^pcme$/) { $cat = "pcme"; } elsif (/^pmode$/) { $cat = "pmode"; } elsif (/^png$/) { $cat = "png"; } elsif (/^progsrcs?$/) { $cat = "progsrc"; } elsif (/^qualitas$/) { $cat = "qualitas"; } elsif (/^reviews?$/) { $cat = "reviews"; } elsif (/^rules?$/) { $cat = "rules"; } elsif (/^scitech$/) { $cat = "scitech"; } elsif (/^serial$/) { $cat = "serial"; } elsif (/^srcs?$|^sources?$/){ $cat = "source"; } elsif (/^specs?$/) { $cat = "specs"; } elsif (/^theory$/) { $cat = "theory"; } elsif (/^utils?$/) { $cat = "utils"; } elsif (/^vla$/) { $cat = "vla"; } elsif (/^watcom$/) { $cat = "watcom"; } elsif (/^wgt$/) { $cat = "wgt"; } elsif (/^windows$/) { $cat = "windows"; } elsif (/^wnt$/) { $cat = "wnt"; } elsif (/^www$/) { $cat = "www"; } elsif (/^x2info$/) { $cat = "x2info"; } elsif (/^x2www$/) { $cat = "x2www"; } elsif (/^xlibs?$/) { $cat = "xlib"; } elsif (/^xwindows?$/) { $cat = "xwindow"; } # elsif (/^notxt$/) { $cat = "notxt"; } else { print "*** Invalid Category '$_'\n"; return $BAD_CATEGORY; } # spelling return $FILE_OK; } # ----------------------------------------------------------------------------- # ## Dissolve # # ----------------------------------------------------------------------------- # # Dissolve the archive under PCWORK # # Note: ERROR records can be created here as well, even though the files # passed ziptest. In that case, "archive format error" will be reported. # # This routine also writes out STATUSFILE to be used when moving the files # onto place. # # Only process archives with good TXT. # # # Return Values # FILE_OK # BAD_FILETYPE # NO_CATEGORY # MAIN_IS_TXT # # Dissolve an archive by Category sub dissolve { $ZL = 0; $ds_err = E_NONE; $DisCount = 0; # Count files in the archive. $Deferred = ""; # Deferred 'Archive:' line. if (!$RealCategory) { # Error ? printf STDERR "\n\nFAIL\t%9s\tNo category given. Dissolving skipped.\n", $mainfile; printf L "FAIL\t%9s\tNo category given. Dissolving skipped.\n", $mainfile; return $NO_CATEGORY; } print "\nCategory '$RealCategory' $mainfile\n"; # Create 'Category' main directory $destdir = $PCWORK . "/" . $RealCategory; if (! -d $destdir) { system ("mkdir $destdir"); chmod 02770, $destdir; } # Write STATUSFILE entry (for Move) printf STF "CHECK\t%d\t$RealCategory\t$mainfile\t$txtfile\n", $CdromStatus; # $RealCategory on korjattu kategoria. # Update the Index file open (IX, ">> $destdir/00add.txt"); printf IX "%s\t%s\t%s\n", $mainfile, $Short, $Source; close IX; # .TXT file itself is the mainfile if ($mainfile =~ /(\.txt|\.doc|\.diz|\.faq|\.nfo|\.readme)/i) { system ("cp $mainfile $destdir"); chmod 0660, "$destdir/$mainfile"; ++$IF_Docs; printf STDERR "\n*** Warning: mainfile is a txt file.\n"; return $MAIN_IS_TXT; } elsif ($txtfile) { system ("cp $txtfile $destdir"); # move the .txt file as well chmod 0660, "$destdir/$txtfile"; } # Finally, process the Mainfile # Create subdir for each archive, and add its name to the path. $zipcomm = ""; $ds_err = dissolve_file("$destdir/$mainfile", $cwd, $mainfile); # # Summary of the archive. $CommentFileName = "$mainfile"; $CommentFileName =~ tr/\./_/; # Remove DOS-offending markers $CommentFileName = "$destdir/" . "$CommentFileName" . ".rem"; if ($zipcomm) { # Did it catch anything ? if ($GlobalCommentFile) { print GLOBAL_CMT $zipcomm; } open (CMT, ">$CommentFileName"); print CMT $zipcomm; close (CMT); chmod 0660, "$CommentFileName"; } # Flag file types included in the archives if ($EvaluateFiletypes) { # Claimed yes, but contents seem suspicious if ($IF_Commercial && $CdromStatus != $CD_NO) { $CdromStatus = $CD_CONFL; printf STDERR "\n*** CD-ROM Status Conflicts.\n"; # CD Conflict printf L "ERROR\t$mainfile\t*** CD-ROM Status Conflicts.\n"; printf N "ERROR\t$mainfile\t*** CD-ROM Status Conflicts.\n"; } printf STF "CONTENT\t%s\t%3s %2s %2s %2s %2s %2s %2s %2s %2s %2s %2s %2s %2s %2s %2s %2s %2s %2s %2s\n", $mainfile, $DisCount, $IF_Readme, $IF_Docs, $IF_Miscinfo, $IF_Source, $IF_Exec, $IF_Config, $IF_Object, $IF_Winapp, $IF_Install, $IF_Data, $IF_Data_audio, $IF_Data_image, $IF_Archive, $IF_System, $IF_UnknownType, $IF_Shareware, $IF_Commercial, $IF_Has_register; # Flag file types included # Write the contents description in plain text to the .rem file. # display content { if ($GlobalCommentFile) { DumpInfoSummary(GLOBAL_CMT, $destdir, $mainfile); } open (CMT, ">>$CommentFileName"); DumpInfoSummary(CMT, $destdir, $mainfile); close (CMT); chmod 0660, "$CommentFileName"; } # display_content } # evaluate return $ds_err; # return last error } # dissolve sub DumpInfoSummary { local ($CMT, $destdir, $mainfile) = @_; printf $CMT "\n$mainfile\n\n"; printf $CMT "Category: $destdir\n"; printf $CMT "Short: %s\n", $Short; printf $CMT "Source: %s\n", $Source; printf $CMT "Keywords: %s\n", $Keywords; printf $CMT "CD-ROM: %s\n", $Cdrom; printf $CMT "\n"; printf $CMT " %2d readme files.\n", $IF_Readme; printf $CMT " %2d document files.\t\t%s\n", $IF_Docs, $DocsList; $IF_Miscinfo && printf $CMT " %2d misc info files.\n", $IF_Miscinfo; printf $CMT " %2d program source files.\t%s\n", $IF_Source, $SourceList; printf $CMT " %2d executable program files.\n", $IF_Exec; $IF_Config && printf $CMT " %2d config data files.\n", $IF_Config; $IF_Object && printf $CMT " %2d compiler object files.\n", $IF_Object; $IF_Winapp && printf $CMT " %2d Windows application files.\n", $IF_Winapp; $IF_Install && printf $CMT " %2d Install datafiles.\n", $IF_Install; $IF_Data && printf $CMT " %2d data files [ %2d audio %2d image].\n", $IF_Data, $IF_Data_audio, $IF_Data_image; $IF_Archive && printf $CMT " %2d archive files.\n", $IF_Archive; $IF_System && printf $CMT " %2d system files.\n", $IF_System; $IF_UnknownType && printf $CMT " %2d unknown type files.\n", $IF_UnknownType; printf $CMT "\n"; printf $CMT " %3d files total.\n\n", $DisCount; printf $CMT " %2d shareware.\n", $IF_Shareware; printf $CMT " %2d commercial.\n", $IF_Commercial; $IF_Has_register && printf $CMT " %2d registering.\n", $IF_Has_register; $CopyingPolicy && printf $CMT " Copyright: %s\n", $CopyingPolicy; $ReplaceList && printf $CMT "\n file is update.\n"; printf $CMT "\n"; printf $CMT "----\n\n"; # file separator } sub dissolve_file { local ($destdir, $srcdir, $mainfile) = @_; local $cmd; local $err = $FILE_OK; # Subdirectory for Mainfile if (! -d $destdir) { system ("mkdir $destdir"); chmod 02770, $destdir; } if (! -f "$srcdir/$mainfile") { printf "*** Mainfile not found: '$srcdir/$mainfile'\n\n"; printf L "FAIL\t$destdir/$mainfile\tFile not found\n"; return ($NO_MAINFILE); } if ($mainfile =~ /(\.asm|\.bas|\.cc?|\.cpp|\.hh?|\.hpp|\.pas)/) { $SourceList .= "$1 "; # Sort these out later... ++$IF_Source; print " copy: $destdir/$mainfile\n"; system ("cp $mainfile $destdir"); # chmod 0660, "$destdir/$mainfile"; } elsif ($mainfile =~ /(\.txt|\.doc|\.e?ps|\.faq|\.man|\.htm|\.swg)/i) { $DocsList .= "$1 "; # Sort these out later... ++$IF_Docs; print " copy: $destdir/$mainfile\n"; system ("cp $mainfile $destdir"); # chmod 0660, "$destdir/$mainfile"; } elsif ($mainfile =~ /\.exe|\.com/i) { ++$IF_Exec; print " copy: $destdir/$mainfile\n"; system ("cp $mainfile $destdir"); # chmod 0660, "$destdir/$mainfile"; } else { if ($mainfile =~ /\.arj|\.ARJ/) { $cmd = "cd $destdir ; $UNARJ $srcdir/$mainfile"; } elsif ($mainfile =~ /\.arc|\.ARC/) { $cmd = "cd $destdir ; $UNARC $srcdir/$mainfile"; } elsif ($mainfile =~ /\.lha|\.LHA|\.lzh|\.LZH/) { $cmd = "$UNLZH xw=$destdir $mainfile"; # $cmd = "cd $destdir ; $UNLZH $srcdir/$mainfile"; } elsif ($mainfile =~ /\.zip|\.ZIP/) { $cmd = "$UNZIP $srcdir/$mainfile -d $destdir"; } elsif ($mainfile =~ /\.zoo|\.ZOO/) { $cmd = "cd $destdir ; $UNZOO $srcdir/$mainfile"; } # UNRAR not available elsif ($mainfile =~ /\.rar|\.RAR/) { # $cmd = "cd $destdir ; $UNRAR $srcdir/$mainfile"; printf L "FAIL\t$destdir/$mainfile\tInvalid filetype: $mainfile\n\n"; printf N "FAIL\tPlease, use $UNRAR for: %s\n", $mainfile; return $BAD_FILETYPE; } else { printf STDERR "\n*** Invalid filetype: $mainfile\n"; printf STDERR "*** FILE SKIPPED: $mainfile\n\n"; printf L "FAIL\t$destdir/$mainfile\tInvalid filetype: $mainfile\n\n"; return $BAD_FILETYPE; } # system ($cmd); $Z = "Z_$ZL"; open ($Z, "$cmd |"); while (<$Z>) { $Verbose && print "$_"; chop; if (/^\s*Archive:\s+/) { # Don't print the 'Archive:' line alone. if ($Deferred) { $zipcomm .= "$Deferred\n"; } $Deferred = $_; next; } elsif (/^\s*creating:\s+/) { next; } # Extract Files # -------------------------------------------------------- # arc ^Extracting file: (file)$ # unarj ^Extracting (FILE) ... Binary file! ... # unzip ^ inflating: (file)$ # unzip ^ exploding: (file)$ # unzip ^ extracting: (file)$ # unzip ^unshrinking: (file)$ # zoo ^Zoo: (file) -- extracted$ # lha ^(file)- Melted $ # if (/^\s*(inflating:|exploding:|unshrinking:|[Ee]xtracting\s+file:|[Ee]xtracting:?)\s+(\S+)/ || /^\s*(Zoo:)\s+(\S+)\s+\-+\s+extracted$/ || /(^\s*)(\S+)\s+\-\ Melted\s*$/) { $FullName = $2; # print "DEBUG: >>$FullName<< \t[Rule '$1']\n"; # Count files extracted ++$DisCount; $err = EvalScan($destdir, $mainfile); } # extracted file # Comment else { if ($Deferred) { # Print deferred 'Archive' line $zipcomm .= "$Deferred\n"; $Deferred = ""; } $zipcomm .= "$_\n" } # comment } # while current archive close $Z; } # else: archive return $err; } # dissolve_file # ----------------------------------------------------------------------------- sub EvalScan { local ($destdir, $mainfile) = @_; local ($destd_strip = $destdir) =~ tr/\//./; local $err = 0; # Filenames with extension: path/file.ext # Fullname must contain full pathname, and NestedName must not. # \s matches whitespace or newline if ($FullName =~ /(\S+)\.([0-9A-Za-z\+\-\_\~\^\$\*\%\!\|]+)\s*$/) { $NestedName = $1; (($NestedType = $2)) || die "Filename extraction failed"; ($destd_strip = $destdir) =~ tr/\//./; $NestedName =~ s/$destd_strip\///; # Strip 'path/' # print "DEBUG: $NestedName \tType '$NestedType']\n"; if ($NestedType =~ /^arc|^arj|^lha|^lzh|^zip|^zoo|^rar/i) { # Do recursion for each sub-archive encountered # Absolute path to the archive is supplied. ++$IF_Archive; printf STDERR "\nRecursion for sub-archive $NestedName.$NestedType\n"; ++$ZL; # dest. dir source dir filename $err = dissolve_file("$destdir/$NestedName", $destdir, "$NestedName.$NestedType"); # if ($err != $FILE_OK) { # DoError($DS_DIS, $err); # } # error --$ZL; # Return to previous input $Z = "Z_$ZL"; } # is sub-archive elsif ($EvaluateFiletypes) { # Flag file types included if ($NestedType =~ /^txt|^doc|^e?ps|^faq|^man|^htm|^swg/i) { $DocsList .= "$1 "; # Sort these out later... ++$IF_Docs; parse_txt_type($NestedName, $NestedType); if (scan_txt($FullName) != $DOC_BINARY && $CreateText) { create_text($FullName); } } elsif ($NestedType =~ /^diz|^nfo|^log|^lsm|^www|^bbs/i) { ++$IF_Miscinfo; parse_txt_type($NestedName, $NestedType); if (scan_txt($FullName) != $DOC_BINARY && $CreateText) { create_text($FullName); } } elsif ($NestedType =~ /^exe|^com/i) { ++$IF_Exec; } elsif ($NestedType =~ /^ini|^sig/i) { ++$IF_Config; } elsif ($NestedType =~ /^hlp|^rtf|^pif/i) { ++$IF_Docs; ++$IF_Winapp; } elsif ($NestedType =~ /^dll/i) { ++$IF_Winapp; } elsif ($NestedType =~ /^cur/i) { ++$IF_System; ++$IF_Winapp; } elsif ($NestedType =~ /^fnt|^pal|^sys/i) { ++$IF_System; } elsif ($NestedType =~ /^\S\S_/i) { ++$IF_Install; } elsif ($NestedType =~ /^dsm|^s3m|^voc|^wav/i) { ++$IF_Data_audio; ++$IF_Data; } elsif ($NestedType =~ /^dat|^3ds|^bbm|^bmp|^lbm|^map|^gif|^jpg|^pcx|^pic|^ppm|^raw|^tga/i) { ++$IF_Data_image; ++$IF_Data; } elsif ($NestedType =~ /^lib/i) { ++$IF_Object; # ++$IF_Library; } elsif ($NestedType =~ /^a$|^o$|^obj|^bgi/i) { ++$IF_Object; } elsif ($NestedName =~ /makefile/i || $NestedType =~ /(^asm|^bas|^cc*$|^cpp|^hh*$|^hpp|^hxx|^inc|^mak|^prj|^pas|^tpu|^s$)/i) { ++$IF_Source; # $1 is source type $SourceList .= "$1 "; # Sort these out later. } # Readme file elsif ($NestedName =~ /^\!*read$|readme|read1st|descript|howto/i || $NestedType =~ /^me|^now|^1st/i) { ++$IF_Readme; parse_txt_type($NestedName, $NestedType); if (scan_txt($FullName) != $DOC_BINARY && $CreateText) { create_text($FullName); } } else { # Unknown filetypes may be text files or archives. # Warn the user about binary files encountered. ++$IF_UnknownType; $Debug && print L "ERROR\t$mainfile\tUnknown filetype '$NestedType'.\n"; # $Verbose && print "unknown filetype '$NestedType'\n"; } } # Evaluate } # File with Extension # Filenames without extension: path/file elsif ($EvaluateFiletypes) { # Flag filetypes included $NestedName = $FullName; $NestedName =~ s/$destd_strip\///; # Strip 'path/' if ($NestedName =~ /makefile/i) { ++$IF_Source; } elsif ($NestedName =~ /^\!*read$|readme|read1st|descript|howto/i) { ++$IF_Readme; parse_txt_type($NestedName, ""); # No extension if (scan_txt($FullName) != $DOC_BINARY && $CreateText) { create_text($FullName); } } elsif ($NestedName =~ /^\invoice/i) { ++$IF_Miscinfo; parse_txt_type($NestedName, ""); # No extension if (scan_txt($FullName) != $DOC_BINARY && $CreateText) { create_text($FullName); } } } # Evaluate return $err; } # EvalScan # ----------------------------------------------------------------------------- sub parse_txt_type { local ($name, $type) = @_; if ($name =~ /^\!*read$|readme|descript/i) { } # Shareware vs. commercial needs to be figured out by # reading the documentation... # Try to find mention of Author, Company, or Copying policy # Note: Licence may be GNU Copyleft # if ($name =~ /copyri*gh*t*|copyrite|copying|policy/i) { # ++$IF_Shareware; # } # if ($name =~ /copyri*gh*t*|copying/i) { # ++$IF_Shareware; # } if ($name =~ /order|licen[cs]e|invoice/i) { ++$IF_Commercial; } if ($name =~ /register/i) { ++$IF_Has_register; } } # parse_txt_type # ----------------------------------------------------------------------------- # # If there is no text file provided, concatenate document files found inside # the archive to create one. # sub create_text { local ($txt, $foo) = @_; local $n; # chop CR LF and EOF printf STDERR "DEBUG: CreateText '$txtfile'\n"; if (!$txtfile) { $n = "$FTP_INCOMING/$mainfile.txt-create"; printf "CreateText: Append '$txt' to '$n'.\n"; ### Clean up non-ASCII ### if ($DosGraphics) { # Remove non-ascii DOS graphics system ("echo $txt >>$n; tr -d '\001-\010\015\032\200-\377' <$txt >>$n"); } else { # chop BELL CR LF and EOF system ("echo $txt >>$n; tr -d '\001-\010\015\032' <$txt >>$n"); } } # no txt } # create_text # ----------------------------------------------------------------------------- # # Move Checked Files onto target directory # # ----------------------------------------------------------------------------- # # List of checked files and their categories is obtained from STATUSFILE # # RECENT file updater, also moves files to right places according to their # Type fields in *.txt files. # sub move_mainloop { # Read logs open (rst, "$STATUSFILE") || die "Can't open $STATUSFILE"; open (ML, ">>$TESTLOG") || die "Can't open $TESTLOG"; # MoveLog printf STDERR "\n--=--=-=--=--=--=--=--=--=--=--=--=--=--=--=--\n"; printf STDERR "\t*** MOVE FILES ***\n"; printf STDERR "--=--=-=--=--=--=--=--=--=--=--=--=--=--=--=--\n"; printf STDERR "Reading Test Status Log\n"; while () { chop; if (/^\s*$/) { next; } # Empty line # $Verbose && print $_; # View processing... if (/^\s*REMARK/) { next; } elsif (/^\s*CWD\s+(\S+)/) { $Path = $1; print $_; } # Find tested files on the status list. elsif (/^\s*CHECK\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/) { $M_CdromStatus{$3} = $1; $M_Category{$3} = $2; $M_Mainfile{$4} = $3; # Notice the name location ... $M_Txtfile{$3} = $4; $M_Path{$3} = $Path; } # CHECK elsif (/^\s*CONTENT\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/) { $M_DisCount{$1} = $2; # Total file count $M_IF_readme{$1} = $3; # Flag file types included $M_IF_docs{$1} = $4; $M_IF_miscinfo{$1} = $5; $M_IF_source{$1} = $6; $M_IF_exec{$1} = $7; $M_IF_config{$1} = $8; $M_IF_object{$1} = $9; $M_IF_winapp{$1} = $10; $M_IF_install{$1} = $11; $M_IF_data{$1} = $12; $M_IF_data_audio{$1}= $13; $M_IF_data_video{$1}= $14; $M_IF_archive{$1} = $15; $M_IF_system{$1} = $16; $M_IF_UnknownType{$1}=$17; $M_IF_shareware{$1} = $18; $M_IF_commercial{$1}= $19; $M_IF_Has_register{$1}= $20; } # CONTENT # Uploader (2 sources) and upload mode elsif (/^\s*MODE\s+(\S+)\s+(\S+)\s/) { $M_BinMode{$1} = $2; $M_From{$1} = $3; $M_UploadDate{$1} = 5; } elsif (/^\s*MAIL\s+(\S+)\s+(\S+)\s+(\S+)\s/) { # 1st Mail rule $M_Uploader{$1} = $2; $M_Author{$1} = $3; } elsif (/^\s*MAIL\s+(\S+)\s+(\S+)\s/) { # 2nd Mail rule $M_Uploader{$1} = $2; $M_Author{$1} = ""; } # Info elsif (/^\s*SHORT\s+(\S+)\s+(.+)/) { $M_Short{$1} = $2; } elsif (/^\s*SOURCE\s+(\S+)\s+(.+)/) { $M_Source{$1} = $2; } elsif (/^\s*KEYWORDS\s+(\S+)\s+(.+)/) { $M_Keywords{$1} = $2; } elsif (/^\s*REPLACE\s+(\S+)\s+(.+)/) { $M_ReplaceList{$1} = $2; ++$M_IsUpdate{$1}; } # Virus Test Log elsif (/^\s*CLEAN\s+(\S+)/) { $M_VirusTest{$1} = $VS_OK; } elsif (/^\s*VIRUS\s+(\S+)\s+(.+)/) { $M_VirusTest{$1} = $VS_INFECTED; $M_VirusList{$VirusCnt++} = $2; } # Misc # ZipTest Log (Note: 'dosmove' stores these on MOVE/HOLD/JUNK entries.) # elsif (/^\s*ok\s+(\S+)/) { $M_ArchiveTest{$1} = $AS_OK; } # elsif (/^\s*ERROR\s+(\S+)/) { $M_ArchiveTest{$1} = $AS_CORRUPT; } else { printf STDERR "Ambiguous keyword '$_'.\n"; } } # while printf "\n"; # Move # # If no filenames are specified on the command line, ask for each file # listed on the Status log. # if (! $ARGV[0]) { @ARGV = sort {$a cmp $b} (keys %M_Txtfile); } (! $ARGV[0]) && die "Filename(s) to move must be specified.\n"; $MoveCnt = 0; # Loop for each file foreach $file (@ARGV) { # View processing... printf "\t%s\t%8s\t%s\n", $M_Category{$file}, $file, $M_Txtfile{$file}; $MoveStatus = move_one_file ($M_Path{$file}, $file, $M_Txtfile{$file}, $M_Category{$file}, $M_Uploader{$file}, $M_CdromStatus{$file}, $M_Short{$file}, $M_Keywords{$1}); # Log MOVE, HOLD or JUNK # Moved ? Only one of these conditions should be true. if ($MoveStatus == $FILE_MOVE) { printf ML "MOVE\t%s\t%s\n", $file, $FinalCategory; ++$MoveCnt; } elsif ($MoveStatus == $FILE_HOLD) { printf ML "HOLD\t%s\t%s\n", $file, $error; # re-upload needed } elsif ($MoveStatus == $FILE_JUNK) { printf ML "JUNK\t%s\t%s\n", $file, $error; # rejected for good next; } else { printf "***ERRCODE\t%s\t%s\n", $file, $MoveStatus; next; } # Finally, after successfull move, remove old files according to # 'Replaces:' field. if ($M_ReplaceList{$file}) { printf "Remove old files: $M_ReplaceList{$file}\n"; # chop ($ans = >> "; chop ($action = ); printf "\n"; if ($action =~ /^\s*[Bb]/) { # Add file on Blacklist junk ($src, $mainfile, $txtfile, $REJECTDIR); add_blacklist ($mainfile, $from); return $FILE_JUNK; } elsif ($action =~ /^\s*[Hh]/) { junk ($src, $mainfile, $txtfile, $HOLDDIR); return $FILE_HOLD; } elsif ($action =~ /^\s*[Jj]/) { junk ($src, $mainfile, $txtfile, $REJECTDIR); return $FILE_JUNK; } elsif ($action =~ /^\s*[Mm]/) { ++$done; } elsif ($action =~ /^\s*[Nn]/) { # Next file return $FILE_SKIP; } elsif ($action =~ /^\s*[Qq]/) { # Quit program printf "Really quit ? "; chop ($ans = ); if ($ans =~ /^\s*[Yy]/) { exit 2; } } # Misc elsif ($action =~ /^\s*[Ll]/) { # List files to move. foreach $file (@ARGV) { printf "%-8s %-8s\t%s\n", $M_Category{$file}, $file, $M_Keywords{$file}; # $M_Path{$file}, $file, $M_Txtfile{$file}, # $M_Category{$file}, $M_Uploader{$file}, # $M_CdromStatus{$file}, $M_Short{$file}, $M_Keywords{$1}; } # for } # Edit Values elsif ($action =~ /^\s*[Cc]/) { $cd = ask_cdrom_status ($cd); } elsif ($action =~ /^\s*[Dd]/) { list_categories(); $categ = ask_category(); } elsif ($action =~ /^\s*[Kk]/) { print "Enter keywords"; chop ($keywords = ); } elsif ($action =~ /^\s*[Ss]/) { printf "Short:\t%s\n", $short; print "Enter short description\n> "; chop ($short = ); } elsif ($action =~ /^\s*[Tt]/) { printf "\n$txtfile:\n"; system ("more $src/$txtfile"); } elsif ($action =~ /^\s*[Uu]/) { printf ("*** Re-scanning text file '$txtfile'\n\n"); clear_records(); scan_txt ("$src/$txtfile"); printf STDERR "DEBUG: return from Scan on line 3307.\n"; $err = check_records (); # do write_keys ($mainfile, 1); # Log key fields OK # Set the local variables accordingly # $src = ; $from = $Uploader; $categ = $RealCategory; $cd = $CdromStatus; $short = $Short; $keywords = $Keywords; display_values ($mainfile, $categ, $short, $keywords, $cd, $from); } elsif ($action =~ /^\s*[Vv]/) { display_content($mainfile); display_values ($mainfile, $categ, $short, $keywords, $cd, $from); } else { print "Invalid move.\n"; } } # done # Move selected -- do Final check display_values ($mainfile, $categ, $short, $keywords, $cd, $from); # Check Category is valid. if (!$categ) { printf STDERR "No Category for %s\n", $mainfile; list_categories(); $categ = ask_category(); } if (($err = &check_prg_category($categ)) == $FILE_OK) { $categ = $cat; } else { ### print "***Invalid Category\n"; ## printed elsewhere list_categories(); $categ = ask_category(); } if (!$short) { printf STDERR "No SHORT-field for %s\n\n", $mainfile; printf "Enter short description: "; chop ($short = ); } if ($AskMv) { printf "Move file ? "; chop ($ans = ); if (!($ans =~ /^\s*[Yy]/)) { return $FILE_SKIP; } } # Check Replace if ($ReplaceList) { printf ML "REPLACE\t \n"; } # Replace # Move files $FinalCategory = $categ; $dirri = "$FTPDIR/programming"; $err = do_mv ($src, $mainfile, $txtfile, "$dirri/$categ", $short); if ($err != $FILE_OK) { return $err; } # Update the CD-ROM database $err = update_cdrom ("$dirri/$categ", $mainfile, $cd); if ($err != $FILE_OK) { printf STDERR "ERROR: Failed to update CD-ROM database.\n"; printf ML "ERROR %d: Failed to update CD-ROM database for %s.\n", $err, $mainfile; return $err; } return $FILE_MOVE; # Move successfull } # move_one_file # ----------------------------------------------------------------------------- sub ask_category { printf "\nEnter Category\n"; chop ($ans = ); $err = &check_prg_category($ans); return ($cat); } # ----------------------------------------------------------------------------- # List Categories available. sub list_categories { printf "\nAvailable Categories on MSDOS Programming\n"; system ("cd $FTPDIR/programming; ls -d [a-z]*"); } # ----------------------------------------------------------------------------- # # This routine actually moves the file specified. Upon success, no questions # are asked. # sub do_mv { local ($src, $mainfile, $txtfile, $dest, $short) = @_; if (!$src || !$dest || !$mainfile) { printf STDERR "Error: Filename parameter(s) missing.\n"; return $NO_CATEGORY; } # Check source directory is not the target. if ($dest eq $src) { return $BAD_CATEGORY; } if (! -d $dest || ! -x $dest) { return $BAD_CATEGORY; } $desti = join('/', $dest, $mainfile); $indexi = join('/', $dest, "00index.txt"); # Check for overwriting # If the target file exists, is it identical with the new file ? if (-e $desti) { # Get the old Short Description. # `grep $mainfile $indexi`; # Compare files if (`diff $src/$file $desti` == 0) { # 0 No differences were found. # 1 Differences were found. # >1 An error occurred. print "Ignoring duplicate. File already moved: '$mainfile'.\n"; printf ("rm $rmopt -- $mainfile $txtfile\n"); # system ("rm $rmopt -- $src/$mainfile $src/$txtfile"); } else { printf "'%s': File exists. Overwrite ? ", $desti; chop ($ans = ); if (!($ans =~ /^\s*[Yy]/)) { return $FILE_EXISTS; } } } # exists # Copy the mainfile onto appropriate category, set permissions, and # finally remove the original from incoming. Move the txtfile # to $TXTDIR directory. printf "*** Moving $mainfile to $dest\n"; printf ML "Moving $mainfile to $dest\n"; system("cp $src/$mainfile $desti"); chmod 0664, $desti; printf( "rm $rmopt -- $src/$mainfile\n"); # system( "rm $rmopt -- $src/$mainfile"); rename ($txtfile, "$TEXTDIR/$txtfile"); if (! open (TIF, ">>$TEXTDIR/00index.txt")) { print "Cannot write $TEXTDIR/$txtfile"; print L "ERROR\t$mainfile\tCannot write $TEXTDIR/$txtfile"; } printf TIF "$dest\t$mainfile\t$txtfile\n"; close TIF; # Index for .txt files. # Remove work delete_work ($categ, $mainfile, $txtfile); # Short: field voi olla monta merkkia pitka. # printataan stringiin, josta sitten vasta ulos --> # filename saa olla pitkakin ... (katkaistaan descriptionista) $krok = sprintf("%4dK %-25s %-.48s", $koko, $dest, $short); printf (outfile "%.79s\n",$krok); # recent files log $krak = sprintf("%-8s\t%-.64s", $mainfile, $short); # Lisataan 00index.txt-fileisiin system("echo >> $indexi '$krak'"); system("sort < $indexi > $indexi.new"); system ("diff $indexi $indexi.new"); rename ("$indexi.new", $indexi); chmod 0664, $indexi; return $FILE_OK; } # do_mv # ----------------------------------------------------------------------------- # # Delete files on the Public Archive # # WARNING: May remove the new file as well, if run in the wrong order. # sub do_rm { local ($cat, $rmlist) = @_; if ($rmlist) { print "\nFiles: $rmlist\n"; # if ($delete == $VERFY) { print "Really delete these files? (y/n) "; chop ($rmverify = ); # } if ($rmverify eq 'y') { # Backup # if ($backup) { # system ("mv $file $BACKUPDIR"); # ++$saved; # } print "Deleting files on FTP archive\n"; # system "rm -- $rmlist"; # Remove old entries in the 00index.txt file system("grep -w -v '^$file' < $indexi > $indexi.new"); system("diff $indexi $indexi.new"); # rename $indexi.new, $indexi; chmod 0664, $indexi; } else { print "Files kept.\n"; } } # rmlist } # do_rm # ----------------------------------------------------------------------------- # # CD-ROM Database Maintenance routines # # ----------------------------------------------------------------------------- sub ask_cdrom_status { local ($old_stat, $foo) = @_; local $c = $old_stat; printf "\nCDROM Distrib.:\t%s\n", $CDString[$old_stat]; printf "Enter new status: Yes, No, Perm, Asked\n"; chop ($ans = ); if (($ans =~ /^yes/i) || ($ans =~ /^sure/i)) { $c = $CD_YES; } elsif (($ans =~ /^no/i) || ($ans =~ /^forbid/i)) { $c = $CD_NO; } elsif (($ans =~ /prior|^written|^perm|require[ds]/i)) { # insensitive $c = $CD_PERM; } elsif (($ans =~ /^asked/i)) { $c = $CD_ASKED; } else { printf STDERR "Unknown or malformed CD-ROM status '$ans'\n"; } return $c; } # ask_cdrom_status # ----------------------------------------------------------------------------- # Update the CD-ROM database sub update_cdrom { local ($cat, $mainfile, $cd) = @_; local $comment = ""; if(! $mainfile || ! -f "$FTPDIR/$cat/$mainfile") { printf (STDERR "Error: Invalid or missing mainfile '$cat/$mainfile'.\n"); return $NO_MAINFILE; } check_cdrom_category ($cat, $mainfile); if (!$CDPrefix[$cd]) { printf STDERR "***Invalid CD_ROM mode for '$mainfile'\n"; return $BAD_CDVALUE; } if ($dirperm != $CD_NONE && $dirperm != $cd) { printf "File permission conflicts directory's default.\n"; } $cd = ask_cdrom_status ($cd); # Claimed yes, but contents seem suspicious # if ($IF_commercial && $cd != $CD_NO) { # $cd = $CD_CONFL; # printf STDERR "\n*** CD-ROM Status Conflicts.\n"; # CD Conflict # } $cdromfile = $cdcat . "/" . $CDPrefix[$cd] . $mainfile; print "Enter CD-ROM comment. End with a .\n"; while ($c = ) { last if $c =~ /^\.\s*$/; $comment .= $c; } if ($comment) { ; } return $FILE_OK; } # update_cdrom # ----------------------------------------------------------------------------- # Delete entry from the CD-ROM database sub delete_cdrom { local ($dest, $mainfile, $cd) = @_; local $err = 0; # $err = check_cdrom_category(); if (-e $mainfile) { return $NO_MAINFILE; } return $FILE_OK; } # delete_cdrom sub check_cdrom_category { local ($cat, $mainfile) = @_; $dirperm = $CD_NONE; if ( -d "$CDROMDIR/$cat") { $cdcat = "$CDROMDIR/$cat"; } elsif ( -f "$CDROMDIR/ON_$cat") { $cdcat = "$CDROMDIR/ON_$cat"; $dirperm = $CD_YES; } elsif ( -f "$CDROMDIR/OFF_$cat") { $cdcat = "$CDROMDIR/OFF_$cat"; $dirperm = $CD_NO; } else { return $BAD_CATEGORY; # Error in the database } if (! -d "$CDROMDIR/$cdcat" || ! -x "$CDROMDIR/$cdcat") { printf STDERR "Error: Cannot access '%s/%s'.\n", $CDROMDIR, $cdcat; return $BAD_CATEGORY; } return $FILE_OK; } # check_cdrom_category # ----------------------------------------------------------------------------- # # Misc Functions # # ----------------------------------------------------------------------------- sub update_indexes { printf "Running $UPDATE_INDEX\n"; system ("$UPDATE_INDEX"); } # update_indexes # ----------------------------------------------------------------------------- sub display_values { local ($mainfile, $categ, $short, $keywords, $cd, $from) = @_; printf "\nFile:\t%s\n", $mainfile; printf "Category:\t%s\n", $categ; printf "Short:\t\t%s\n", $short; printf "Keywords:\t%s\n", $keywords; printf "CDROM Distrib.:\t%s\n", $CDString[$cd]; # printf "Replaces:\t%s\n", $M_ReplaceList{$mainfile}; printf "Uploader:\t%s\n\n", $from; if (!$categ) { printf STDERR "*** No Category for %s\n", $mainfile; } if (!$short) { printf STDERR "*** No SHORT-field for %s\n", $mainfile; } } # sub display_values # ----------------------------------------------------------------------------- # Flag file types included sub display_content { local ($file, $foo) = @_; printf "\n$file\n"; printf " %2d readme files.\n", $M_IF_readme{$file}; printf " %2d document files.\n", $M_IF_docs{$file}; $M_IF_miscinfo{$file} && printf " %2d misc info files.\n", $M_IF_miscinfo{$file}; printf " %2d program source files.\t%s\n", $M_IF_source{$file}, $M_SourceList{$file}; printf " %2d executable program files.\n", $M_IF_exec{$file}; $M_IF_config{$file} && printf " %2d config data files.\n", $M_IF_config{$file}; $M_IF_object{$file} && printf " %2d compiler object files.\n", $M_IF_object{$file}; $M_IF_winapp{$file} && printf " %2d Windows application files.\n", $M_IF_winapp{$file}; $M_IF_install{$file} && printf " %2d Install datafiles.\n", $M_IF_install{$file}; $M_IF_data{$file} && printf " %2d data files.\n", $M_IF_data{$file}; $M_IF_archive{$file} && printf " %2d archive files.\n", $M_IF_archive{$file}; $M_IF_system{$file} && printf " %2d system files.\n", $M_IF_system{$file}; $M_IF_UnknownType{$file} && printf " %2d unknown type files.\n", $M_IF_UnknownType{$file}; printf " %3d files total.\n", $M_DisCount{$file}; printf " %2d shareware.\n", $M_IF_shareware{$file}; printf " %2d commercial.\n", $M_IF_commercial{$file}; # $M_ReplaceList{$file} && printf "\n file is update.\n"; printf "\n"; } # display_content # ----------------------------------------------------------------------------- # HOLD or JUNK a file sub junk { local ($src, $mainfile, $txtfile, $dest) = @_; local $c = ''; if (!$src || !$dest || !$mainfile) { printf STDERR "Error: Filename parameter(s) missing.\n"; return $NO_CATEGORY; } printf "Do you really want to JUNK '$mainfile' ? "; chop ($ans = ); if (!($ans =~ /^\s*[Yy]/)) { return $FILE_SKIP; } # Move the file to HOLD or REJECT directory rename ("$src/$mainfile", "$dest/$mainfile"); rename ("$src/$txtfile", "$dest/$txtfile"); # Add file to Rejectlog if (!open (R, ">>$REJECTLOG")) { printf "Cannot open Reject Log file.\n"; return; } printf "Enter Rejection comment (only one line):\n> "; chop ($c = ); printf R "\t%-8s\t- %s\n", $mainfile, $c; close R; } # junk sub add_blacklist { local ($file, $from) = @_; local $c = ''; printf "File:\t%s\n", $file; printf "Uploader:\t%s\n", $from; printf "Enter Blacklist comment (only one line):\n> "; chop ($c = ); # Write entry to Blacklist printf "Are you sure ? "; chop ($ans = ); if (!($ans =~ /^\s*[Yy]/)) { return $FILE_SKIP; } open (B, ">>$BLACKLIST") || die "Cannot write Blacklist file.\n"; printf B "%s\t%s\t%s\n", $file, $from, $c; close B; } # add_blacklist # ----------------------------------------------------------------------------- # Recursively delete the dissolved file from the PCWORK directory sub delete_work { local ($cat, $mainfile, $txtfile) = @_; if ( -e "$PCWORK/$categ/$mainfile") { printf STDERR "Remove '%s' on workdir '%s/%s'.\n", $mainfile, $PCWORK, $cat; system( "/bin/rm -rf $PCWORK/$cat/$mainfile*"); system( "/bin/rm -f $PCWORK/$cat/$txtfile"); } return $FILE_OK; } # delete_cdrom