Annotation of loncom/publisher/lonupload.pm, revision 1.5
1.1 www 1: # The LearningOnline Network with CAPA
2: # Handler to upload files into construction space
3: #
4: # (Handler to retrieve an old version of a file
5: #
6: # (Publication Handler
7: #
8: # (TeX Content Handler
9: #
10: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
11: #
12: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
13: # 03/23 Guy Albertelli
14: # 03/24,03/29 Gerd Kortemeyer)
15: #
16: # 03/31,04/03 Gerd Kortemeyer)
17: #
1.5 ! www 18: # 04/05,04/09,05/25,06/23 Gerd Kortemeyer
1.1 www 19:
20: package Apache::lonupload;
21:
22: use strict;
23: use Apache::File;
24: use File::Copy;
25: use Apache::Constants qw(:common :http :methods);
1.3 www 26: use Apache::loncacc;
1.1 www 27:
1.2 www 28: sub upfile_store {
29: my $r=shift;
30:
31: my $fname=$ENV{'form.upfile.filename'};
32: $fname=~s/\W//g;
33:
34: chop($ENV{'form.upfile'});
1.1 www 35:
1.2 www 36: my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
37: '_upload_'.$fname.'_'.time.'_'.$$;
38: {
39: my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
40: '/tmp/'.$datatoken.'.tmp');
41: print $fh $ENV{'form.upfile'};
1.1 www 42: }
1.2 www 43: return $datatoken;
44: }
45:
46:
47: sub phaseone {
1.5 ! www 48: my ($r,$fn,$uname,$udom)=@_;
! 49: if ($ENV{'form.upfile.filename'}) {
1.2 www 50: $fn=~s/\/[^\/]+$//;
51: $fn=~s/([^\/])$/$1\//;
52: $fn.=$ENV{'form.upfile.filename'};
1.3 www 53: $fn=~s/^\///;
54: $fn=~s/(\/)+/\//g;
55: if (($fn) && ($fn!~/\/$/)) {
56: $r->print(
1.2 www 57: '<form action=/adm/upload method=post>'.
58: '<input type=hidden name=phase value=two>'.
59: '<input type=hidden name=datatoken value="'.&upfile_store.'">'.
60: 'Store uploaded file as '.
1.3 www 61: '<input type=text size=50 name=filename value="/priv/'.
62: $uname.'/'.$fn.'"><br>'.
1.2 www 63: '<input type=submit value="Store"></form>');
1.3 www 64: } else {
65: $r->print('<font color=red>Illegal filename.</font>');
66: }
1.5 ! www 67: } else {
! 68: $r->print('<font color=red>No upload file specified.</font>');
! 69: }
1.1 www 70: }
71:
72: sub phasetwo {
1.4 www 73: my ($r,$fn,$uname,$udom)=@_;
74: if ($fn=~/^\/priv\/$uname\//) {
1.3 www 75: my $tfn=$fn;
76: $tfn=~s/^\/(\~|priv)\/(\w+)//;
77: my $target='/home/'.$uname.'/public_html'.$tfn;
1.2 www 78: my $datatoken=$ENV{'form.datatoken'};
79: if (($fn) && ($datatoken)) {
80: if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) {
81: $r->print(
82: '<form action=/adm/upload method=post>'.
83: 'File <tt>'.$fn.'</tt> exists. Overwrite? '.
84: '<input type=hidden name=phase value=two>'.
85: '<input type=hidden name=filename value="'.$fn.'">'.
86: '<input type=hidden name=datatoken value="'.$datatoken.'">'.
87: '<input type=submit name=override value="Yes"></form>');
88: } else {
89: my $source=$r->dir_config('lonDaemons').
90: '/tmp/'.$datatoken.'.tmp';
91: if (copy($source,$target)) {
92: $r->print('File copied.');
1.3 www 93: $r->print('<p><font size=+2><a href="'.$fn.
1.2 www 94: '">View file</a></font>');
95: } else {
96: $r->print('Failed to copy: '.$!);
97: }
98: }
1.1 www 99: } else {
100: $r->print(
1.2 www 101: '<font size=+1 color=red>Please pick a filename</font><p>');
1.1 www 102: &phaseone($r,$fn,$uname,$udom);
103: }
1.4 www 104: } else {
105: $r->print(
106: '<font size=+1 color=red>Please pick a filename</font><p>');
107: &phaseone($r,$fn,$uname,$udom);
108: }
1.1 www 109: }
110:
111: sub handler {
112:
113: my $r=shift;
114:
1.3 www 115: my $uname;
116: my $udom;
117:
1.5 ! www 118: ($uname,$udom)=
1.3 www 119: &Apache::loncacc::constructaccess(
1.5 ! www 120: $ENV{'form.filename'},$r->dir_config('lonDefDomain'));
! 121: unless (($uname) && ($udom)) {
1.3 www 122: $r->log_reason($uname.' at '.$udom.
123: ' trying to publish file '.$ENV{'form.filename'}.
124: ' - not authorized',
125: $r->filename);
126: return HTTP_NOT_ACCEPTABLE;
127: }
128:
1.1 www 129: my $fn;
130:
131: if ($ENV{'form.filename'}) {
132: $fn=$ENV{'form.filename'};
1.3 www 133: $fn=~s/^http\:\/\/[^\/]+\/(\~|priv\/)(\w+)//;
1.1 www 134: } else {
135: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
1.2 www 136: ' unspecified filename for upload', $r->filename);
1.1 www 137: return HTTP_NOT_FOUND;
138: }
139:
140: # ----------------------------------------------------------- Start page output
141:
142:
143: $r->content_type('text/html');
144: $r->send_http_header;
145:
146: $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
147:
148: $r->print(
149: '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
150:
151:
1.2 www 152: $r->print('<h1>Upload file to Construction Space</h1>');
1.3 www 153:
154: if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
155: $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom.
156: '</font></h3>');
157: }
158:
1.1 www 159:
160: if ($ENV{'form.phase'} eq 'two') {
161: &phasetwo($r,$fn,$uname,$udom);
162: } else {
163: &phaseone($r,$fn,$uname,$udom);
164: }
165:
166: $r->print('</body></html>');
167: return OK;
168: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonupload.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / publisher