\n" . "" . "help on managing software files
"; my $back = "
"
. "If there is a permissions problem then you "
. "need to make sure that the user "
. $util->GetUserName() . " has permission to create a file in $dir.");
}
}
sub DeleteLockfile {
my $file = shift; # file that is locked
my $lockfile = "$file" . ".lock";
unless (unlink ($lockfile)) {
print STDERR "Can't unlink $lockfile : reason $!";
}
}
sub GetMirrorInfo {
unless (-e $mirrorfile) {
unless (open (FOO, ">$mirrorfile")) {
$util->ErrorMessage("Can't create $mirrorfile.
Reason : $!
\n"
. "If there is a permissions problem then you need to "
. "make sure that the user " . $util->GetUserName()
. " has permission to create a file in $filepath/files");
}
close FOO;
}
# the mirror file should not be readable until this program
# needs it. that's because it might contain username/passwd
# pairs used for mirroring. after we read the file in we should
# set the permissions back to unreadable. this prevents people
# from retrieving the file via http
unless (chmod 0600, $mirrorfile) {
$util->ErrorMessage("Can't chmod mirror file : $!");
}
&CreateLockfile($mirrorfile, 5);
unless (open (MIRROR, "<$mirrorfile")) {
&DeleteLockfile($mirrorfile);
chmod 0000, $mirrorfile;
$util->ErrorMessage("Can't read $mirrorfile.
Reason : $!\n
"
. "If there is a permissions problem then you need to "
. "make sure that the user " . $util->GetUserName()
. " has permission to read the file $mirrorfile");
}
undef ($/);
my $buf = \n";
if ($in{email}) {
print "The results of the mirroring process will be sent to $in{email}.\n";
print "That message will tell you which files were checked and if they were\n";
print "updated or unchanged.\n";
} else {
print "Since you did not specify an email address to send the results of the\n";
print "mirroring process to, you will not be informed of the status of the upload.\n";
print "However, you can check the date on the main";
print "software management page to see when the last successful update was\n";
print "completed.\n";
}
print $back;
exit (0);
} elsif (defined $pid) {
# 2nd fork forces child into background
unless (fork) { #child's child
## there's a bug in NCSA httpd1.3 and some netscape servers
## that prevents backgrounding of the child process. so the
## first 20 filehandles are closed. This kills unclosed
## socket
my $SYS_close;
if (`uname -s` =~ /irix/i) {
# per /usr/include/sys.s
$SYS_close = 1006;
} else {
$SYS_close = 6;
}
if (`uname -s` !~ /aix/i) {
my $i;
for ($i=0; $i<20; $i++) {
eval {syscall($SYS_close, $i+0)};
}
}
sleep 1 until getppid == 1;
$in{email}=~ s/\s*(\S*)\s*/$1/;
delete $in{email} unless $in{email} =~ /^[A-Za-z0-9\.-~]+@[A-Za-z0-9\.-~]+$/;
if ($in{email}) {
exec "./update_mirrors.pl", "-e", "$in{email}";
} else {
exec "./update_mirrors.pl";
}
}
## first child exits quickly
exit (0);
} else {
print "Mirroring not started\n";
print "The mirroring process could not be started because of a\n";
print "fork error : $!\n";
print $back;
exit(0);
}
}
## display form for mirroring update
print "When you start the update process, all of the software which is mirrored\n";
print "by this repository will be checked at its master site and updated if necessary.\n";
print "Since this update process can take a long time to complete and shouldn't\n";
print "be interrupted, the process\n";
print "will start in the background after you press the start\n";
print "button below.\n";
print " If you specify an email address \n";
print "then the results of the update will be sent to that address when the process\n";
print "has completed. Otherwise, the process will finish its job silently. It is\n";
print "recommended that you specify an email address.\n \n";
print " Reason: $!");
}
}
## if this file is set up for mirroring then update the mirror info file
if (-f $mirrorfile) {
unless (chmod 0600, $mirrorfile) {
$util->ErrorMessage("Can't chmod mirror file : $!");
}
&CreateLockfile($mirrorfile, 5);
unless (open (MIRROR, "+<$mirrorfile")) {
&DeleteLockfile($mirrorfile);
chmod 0000, $mirrorfile;
$util->ErrorMessage("Can't open $mirrorfile "
. "If there is a permissions problem then you need to "
. "make sure that the user " . $util->GetUserName()
. " has permission to read the file $mirrorfile");
}
undef ($/);
my $buf = Please back "
. "up and try your submission again.");
}
if ($in{newname} eq $in{filename}) {
$util->ErrorMessage("You did not choose a new filename but instead repeated the "
. "current one. Please back up and try your submission again.");
}
unless (opendir (DIR, "$filepath/files")) {
$util->ErrorMessage("Can't opendir $filepath/files : $!");
}
my $file;
foreach $file (readdir(DIR)) {
if ($in{newname} eq $file) {
$util->ErrorMessage("The new filename that you chose is already being "
. "used in this repository's upload directory. Please "
. "back up and choose a different name. Alternatively, "
. "you can delete the file that is "
. "already using this name.");
}
}
print "Are you sure that you want to rename the file "$in{filename}" ";
print "to "$in{newname}"? ";
print "
Reason : $!\nSuccess
\n";
print "The file has been renamed.\n";
print $back;
exit;
}
elsif ($in{filename} && $in{newname}) {
$in{newname} =~ s/^\s*(\S+)\s*$/$1/m;
if ($in{newname} !~ /^[A-Za-z0-9\.,_-]+$/) {
$util->ErrorMessage("The new filename that you choose can only have "
. "alphanumeric characters. The following characters "
. "are also acceptable :
. , _ -\n