version 1.1, 2001/04/05 19:35:15
|
version 1.2, 2001/04/10 01:57:28
|
Line 15
|
Line 15
|
# |
# |
# 03/31,04/03 Gerd Kortemeyer) |
# 03/31,04/03 Gerd Kortemeyer) |
# |
# |
# 04/05 Gerd Kortemeyer |
# 04/05,04/09 Gerd Kortemeyer |
|
|
package Apache::lonupload; |
package Apache::lonupload; |
|
|
Line 24 use Apache::File;
|
Line 24 use Apache::File;
|
use File::Copy; |
use File::Copy; |
use Apache::Constants qw(:common :http :methods); |
use Apache::Constants qw(:common :http :methods); |
|
|
sub phaseone { |
|
my ($r,$fn,$uname,$udom)=@_; |
|
my $docroot=$r->dir_config('lonDocRoot'); |
|
|
|
my $urldir='/res/'.$udom.'/'.$uname.$fn; |
|
$urldir=~s/\/[^\/]+$/\//; |
|
|
|
my $resfn=$docroot.'/res/'.$udom.'/'.$uname.$fn; |
sub upfile_store { |
my $resdir=$resfn; |
my $r=shift; |
$resdir=~s/\/[^\/]+$/\//; |
|
|
my $fname=$ENV{'form.upfile.filename'}; |
$fn=~/^\/(.+)\.(\w+)$/; |
$fname=~s/\W//g; |
my $main=$1; |
|
my $suffix=$2; |
chop($ENV{'form.upfile'}); |
|
|
$r->print('<form action=/adm/retrieve method=post>'. |
my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}. |
'<input type=hidden name=filename value="'.$fn.'">'. |
'_upload_'.$fname.'_'.time.'_'.$$; |
'<input type=hidden name=phase value=two>'. |
{ |
'<table border=2><tr><th>Select</th><th>Version</th>'. |
my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons'). |
'<th>Became this version on ...</th>'. |
'/tmp/'.$datatoken.'.tmp'); |
'<th>Metadata</th></tr>'); |
print $fh $ENV{'form.upfile'}; |
my $filename; |
|
opendir(DIR,$resdir); |
|
while ($filename=readdir(DIR)) { |
|
if ($filename=~/^$main\.(\d+)\.$suffix$/) { |
|
my $version=$1; |
|
my ($rdev,$rino,$rmode,$rnlink, |
|
$ruid,$rgid,$rrdev,$rsize, |
|
$ratime,$rmtime,$rctime, |
|
$rblksize,$rblocks)=stat($resdir.'/'.$filename); |
|
$r->print('<tr><td><input type=radio name=version value="'. |
|
$version.'"></td><th>'.$version.'</th><td>'. |
|
localtime($rmtime).'</td><td>'. |
|
'<a href="'.$urldir.$filename.'.meta" target=cat>'. |
|
'Metadata Version '.$version.'</a></td></tr>'); |
|
} |
|
} |
} |
closedir(DIR); |
return $datatoken; |
my ($rdev,$rino,$rmode,$rnlink, |
} |
$ruid,$rgid,$rrdev,$rsize, |
|
$ratime,$rmtime,$rctime, |
|
$rblksize,$rblocks)=stat($resfn); |
sub phaseone { |
$r->print('<tr><td><input type=radio name=version value="new"></td>'. |
my ($r,$fn,$uname,$udom)=@_; |
'<th>Current</th><td>'.localtime($rmtime). |
$fn=~s/\/[^\/]+$//; |
'</td><td><a href="'.$urldir.$main.'.'.$suffix.'.meta" target=cat>'. |
$fn=~s/([^\/])$/$1\//; |
'Metadata current version</a></td></tr></table><p>'. |
$fn.=$ENV{'form.upfile.filename'}; |
'<font size=+1 color=red>Retrieval of an old version will '. |
$r->print( |
'overwrite the file currently in construction space</font><p>'. |
'<form action=/adm/upload method=post>'. |
'<input type=submit value="Retrieve version"></form>'); |
'<input type=hidden name=phase value=two>'. |
|
'<input type=hidden name=datatoken value="'.&upfile_store.'">'. |
|
'Store uploaded file as '. |
|
'<input type=text size=50 name=filename value="'.$fn.'"><br>'. |
|
'<input type=submit value="Store"></form>'); |
} |
} |
|
|
sub phasetwo { |
sub phasetwo { |
my ($r,$fn,$uname,$udom)=@_; |
my ($r,$fn,$uname,$udom)=@_; |
if ($ENV{'form.version'}) { |
my $target='/home/'.$uname.'/public_html'.$fn; |
my $version=$ENV{'form.version'}; |
my $datatoken=$ENV{'form.datatoken'}; |
if ($version eq 'new') { |
if (($fn) && ($datatoken)) { |
$r->print('<h3>Retrieving current (most recent) version</h3>'); |
if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) { |
} else { |
$r->print( |
$r->print('<h3>Retrieving old version '.$version.'</h3>'); |
'<form action=/adm/upload method=post>'. |
} |
'File <tt>'.$fn.'</tt> exists. Overwrite? '. |
my $logfile; |
'<input type=hidden name=phase value=two>'. |
my $ctarget='/home/'.$uname.'/public_html'.$fn; |
'<input type=hidden name=filename value="'.$fn.'">'. |
my $vfn=$fn; |
'<input type=hidden name=datatoken value="'.$datatoken.'">'. |
if ($version ne 'new') { |
'<input type=submit name=override value="Yes"></form>'); |
$vfn=~s/\.(\w+)$/\.$version\.$1/; |
} else { |
} |
my $source=$r->dir_config('lonDaemons'). |
my $csource=$r->dir_config('lonDocRoot').'/res/'.$udom.'/'.$uname.$vfn; |
'/tmp/'.$datatoken.'.tmp'; |
unless ($logfile=Apache::File->new('>>'.$ctarget.'.log')) { |
if (copy($source,$target)) { |
$r->print( |
$r->print('File copied.'); |
'<font color=red>No write permission to user directory, FAIL</font>'); |
$r->print('<p><font size=+2><a href="/priv/'.$uname.$fn. |
} |
'">View file</a></font>'); |
print $logfile |
} else { |
"\n\n================= Retrieve ".localtime()." ================\n". |
$r->print('Failed to copy: '.$!); |
"Version: $version\nSource: $csource\nTarget: $ctarget\n"; |
} |
$r->print('<p>Copying file: '); |
} |
if (copy($csource,$ctarget)) { |
|
$r->print('ok<p>'); |
|
print $logfile "Copied sucessfully.\n\n"; |
|
} else { |
|
my $error=$!; |
|
$r->print('fail, '.$error.'<p>'); |
|
print $logfile "Copy failed: $error\n\n"; |
|
} |
|
$r->print('<font size=+2><a href="/priv/'.$uname.$fn. |
|
'">Back to '.$fn.'</a></font>'); |
|
} else { |
} else { |
$r->print( |
$r->print( |
'<font size=+1 color=red>Please pick a version to retrieve</font><p>'); |
'<font size=+1 color=red>Please pick a filename</font><p>'); |
&phaseone($r,$fn,$uname,$udom); |
&phaseone($r,$fn,$uname,$udom); |
} |
} |
} |
} |
Line 127 sub handler {
|
Line 100 sub handler {
|
$fn=~s/^http\:\/\/[^\/]+\/\~(\w+)//; |
$fn=~s/^http\:\/\/[^\/]+\/\~(\w+)//; |
} else { |
} else { |
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
' unspecified filename for retrieval', $r->filename); |
' unspecified filename for upload', $r->filename); |
return HTTP_NOT_FOUND; |
return HTTP_NOT_FOUND; |
} |
} |
|
|
unless ($fn) { |
|
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
|
' trying to retrieve non-existing file', $r->filename); |
|
return HTTP_NOT_FOUND; |
|
} |
|
|
|
# ----------------------------------------------------------- Start page output |
# ----------------------------------------------------------- Start page output |
|
|
my $uname=$ENV{'user.name'}; |
my $uname=$ENV{'user.name'}; |
Line 151 sub handler {
|
Line 118 sub handler {
|
'<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); |
'<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); |
|
|
|
|
$r->print('<h1>Retrieve previous versions of <tt>'.$fn.'</tt></h1>'); |
$r->print('<h1>Upload file to Construction Space</h1>'); |
|
|
if ($ENV{'form.phase'} eq 'two') { |
if ($ENV{'form.phase'} eq 'two') { |
&phasetwo($r,$fn,$uname,$udom); |
&phasetwo($r,$fn,$uname,$udom); |