#!/usr/local/bin/perl5 -w # Add latest URL Information to file # require "cgi-lib.pl"; $mailprog = '/usr/lib/sendmail'; # $statusofread = &ReadParse(*formdata); $userdir = 'standalone'; if( $statusofread && exists($formdata{"username"}) ) { $userdir = $formdata{"username"} if( defined($formdata{"username"}) ); } $testuserdir = $userdir; $testuserdir =~ tr/A-Z/a-z/; if( ($testuserdir eq 'guest') || ($testuserdir =~ m%^anon%) ) { $userdir = 'standalone'; } # # Base URL $basefordumping = "/usr/local/archives/public/html/users/gcf/nobody/webwisdom/"; # $today =`date`; chomp($today); # $basefordumping .= $userdir .'/'; # $filetodumpto = $basefordumping . 'storeurl'; # $count = 0; while (!&LockDatabase($filetodumpto)) { # Sleep for a second sleep(1); ++$count; &therewaserror("Server out to lunch -- please email -- lock stuck") if($count > 20); } # # $dumperrorflag=0; if(-e $filetodumpto ) { open(FILETODUMPTO,'>>'.$filetodumpto) || ($dumperrorflag=1); } else { open(FILETODUMPTO,'>'.$filetodumpto) || ($dumperrorflag=1); print FILETODUMPTO "List of URL's Visited\n"; } if( $dumperrorflag == 1 ) { print "Location: http://boss.npac.syr.edu:8080/users/gcf/wisdom/StandAloneDumpedError.html\n\n"; &UnlockDatabase($filetodumpto); exit 1; } # print FILETODUMPTO "New URL ",$today," "; print FILETODUMPTO $ENV{'REMOTE_ADDR'},' ',$ENV{'REMOTE_HOST'},' '; # if( $statusofread ) { print FILETODUMPTO $formdata{"url"},"\n"; } else { $dumperrorflag=1; print FILETODUMPTO "Error\n"; } close(FILETODUMPTO); open(FILETODUMPTO,'>>'.$filetodumpto) || ($dumperrorflag=1); close(FILETODUMPTO); # &UnlockDatabase($filetodumpto); # if( $dumperrorflag == 1 ) { print "Location: http://boss.npac.syr.edu:8080/users/gcf/wisdom/StandAloneDumpedError.html\n\n"; } else { print "Location: http://boss.npac.syr.edu:8080/users/gcf/wisdom/StandAloneDumped.html\n\n"; } exit; # sub therewaserror { my($mess) = @_; # print < Error in standalonedump.pl Processing!

Error in Processing URL Logging: $mess

Please correct or if it's our fault Mail Complaint
EOF exit; } sub LockDatabase { # PURPOSE: Attempt to "lock" the database by creating a lock file. # INPUTS: Database file name # OUTPUTS: A boolean telling if the lock was successful my ($dbfile) = @_; if (-e "$dbfile.lock") { # DB is already locked return 0; } else { system("touch $dbfile.lock"); # Create the lock file return 1; } } sub UnlockDatabase { # PURPOSE: Attempt to "unlock" the database by deleting the lock file. # INPUTS: Database file name # OUTPUTS: None (but should probably check that the unlock was successful) my ($dbfile) = @_; unless( (unlink("$dbfile.lock")) ) { open (MAIL, "|$mailprog gcf") || (&therewaserror("Server Error Can't Mail -- Please email us")) ; print MAIL <>/usr/local/archives/public/html/users/gcf/nobody/webwisdom/debug') || return; foreach $val (@_) { if(defined($val) ) { print DEBUGFILE $val,' '; } else { print DEBUGFILE 'Undefined '; } } print DEBUGFILE "\n"; close(DEBUGFILE); return; } # 1;