]> git.treefish.org Git - fex.git/blob - cgi-bin/foc
e5eea41e90dcfcfd4332d206a99486df0c9d7f6f
[fex.git] / cgi-bin / foc
1 #!/usr/bin/perl -wT
2
3 # FEX CGI for (user) operation control
4 #
5 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
6 #
7
8 use CGI         qw(:standard);
9 use CGI::Carp   qw(fatalsToBrowser);
10 use Fcntl       qw(:flock);
11 use Digest::MD5 qw(md5_hex);
12
13 $CGI::LIST_CONTEXT_WARN = 0;
14 $CGI::LIST_CONTEXT_WARN = 0;
15
16 # add fex lib
17 ($FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
18 die "$0: no $FEXLIB\n" unless -d $FEXLIB;
19
20 our ($FEXHOME,$mdomain,$nomail,$faillog);
21 our $akey = '';
22
23 # load common code, local config : $HOME/lib/fex.ph
24 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
25
26 my $error = 'F*EX operation control ERROR';
27
28 chdir $spooldir or die "$spooldir - $!\n";
29
30 $akeydir = "$spooldir/.akeys"; 
31 $user = $id = '';
32
33 # look for CGI parameters
34 foreach my $v (param) {
35   my $vv = param($v);
36   debuglog("Param: $v=\"$vv\"");
37   if ($v =~ /^akey$/i and $vv =~ /^(\w+)$/) { 
38     $akey = $1;
39   } elsif ($v =~ /^(from|user)$/i) {
40     $user = normalize_email($vv);
41     $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
42   } elsif ($v =~ /^id$/i) {
43     $id = checkchars($vv);
44   }
45 }
46
47 if ($akey and not $user and not $id) {
48   if (open $akey,'<',"$akeydir/$akey/@" and $id = getline($akey)) {
49     close $akey;
50     $user = readlink "$akeydir/$akey"
51       or http_die("internal server error: no $akey symlink");
52     $user =~ s:.*/::;
53     $user = untaint($user);
54     if ($akey ne md5_hex("$user:$id")) {
55       $user = $id = '';
56     }
57   }
58 }
59
60 $head = "$ENV{SERVER_NAME} F*EX operation control";
61
62 # display HTML form and request user data
63 if ($user and $id) {
64   my $idf;
65   unless (open $idf,'<',"$user/@") {
66     faillog("user $from, id $id");
67     html_error($error,"wrong user or auth-ID");
68   }
69   &check_status($user);
70   if (-e "$user/\@CAPTIVE") { html_error($error,"captive user") }
71   $rid = getline($idf);
72   close $idf;
73   if ($id eq $rid) {
74     unless ($akey) {
75       $akey = untaint(md5_hex("$user:$id"));
76       unlink "$akeydir/$akey";
77       symlink "../$user","$akeydir/$akey";
78     }
79   } else {
80     faillog("user $from, id $id");
81     html_error($error,"wrong user or auth-ID");
82   }
83   unlink $faillog if $faillog;
84   http_header("200 OK");
85   print html_header($head);
86   # authorized login URL
87   my $url = "$ENV{PROTO}://$ENV{HTTP_HOST}/fup/".b64("from=$user&id=$id");
88   pq(qq(
89     '<h2>for user <a href="$url">$user</a></h2>'
90     '<table>'
91   ));
92   ($quota,$du) = check_sender_quota($user);
93   if ($quota) {
94     pq(qq(
95       <tr title="You as the sender have a server disk quota of $quota MB and currently using $du MB">
96         <td>sender quota (used):<td align=\"right\">$quota ($du) MB
97       </tr>
98     ));
99   }
100   ($quota,$du) = check_recipient_quota($user);
101   if ($quota) {
102     pq(qq(
103       <tr title="You as the recipient have a server disk quota of $quota MB and currently using $du MB">
104         <td>recipient quota (used):<td align=\"right\">$quota ($du) MB
105       </tr>
106     ));
107   }
108   pq(qq(
109     '</table>'
110     '<p><hr><p>'
111     '<a href="/fup?akey=$akey&command=LISTRECEIVED">'
112     'Retrieve a list of all your received files</a> in F*EX spool.'
113   ));
114   pq(qq(
115     '<p><hr><p>'
116     '<form action="/fuc?akey=$akey"'
117     '      method="post"'
118     '      accept-charset="UTF-8"'
119     '      enctype="multipart/form-data">'
120     '  <input type="hidden" name="user" value="$user">'
121     '  <input type="hidden" name="id"   value="$id">'
122     '  <script>function show_id() {return(alert("auth-ID: $id"));}</script>'
123     '  Change your <a href="" onclick="show_id();" title="$id">auth-ID</a> to'
124     '  <input type="text"   name="nid"  size="16">'
125     '  <input type="submit" value="remember it!">'
126   ));
127   if (-s "$user/\@ALLOWED_RECIPIENTS") {
128     # pq(qq(
129     #  '  (You are a restricted user)';
130     #  '  <p>'
131     # ));
132     #    '<p><hr><p>'
133     #    '<a href="/fup?akey=$akey&command=LISTSENT">'
134     #    'Show download URLs of files you have sent</a>.'
135     unless ($nomail) {
136       pq(qq(
137         '<p><hr><p>'
138         '<a href="/fup?akey=$akey&command=RENOTIFY">'
139         'Resend notification e-mails for files you have sent</a>.'
140       ));
141     }
142   } else {
143     pq(qq(
144       '<p><hr><p>'
145       '<a href="/fup?akey=$akey&command=LIST&to=*">'
146       'Forward a copy of a file</a> you already have uploaded to another recipient.'
147       '<p><hr><p>'
148       '<a href="/rup?akey=$akey">'
149       'Redirect files</a> you have uploaded to a wrong or misspelled recipient.'
150     ));
151     unless ($nomail) {
152       pq(qq(
153         '<p><hr><p>'
154         '<a href="/fup?akey=$akey&command=RENOTIFY">'
155         'Resend notification e-mails for files you have sent</a>.'
156       ));
157     }
158     pq(qq(
159       '<p><hr><p>'
160       '  Create a subuser who can send you files. Enter his e-mail address:<br>'
161       '  <input type="text" name="subuser" size="60">'
162       '  <input type="checkbox" name="otuser" value="once">for only one upload<br>'
163     ));
164     if ($nomail) {
165       pq(qq(
166         '  <input type="submit" value="create subuser">'
167       ));
168     } else {
169       pq(qq(
170         '  Comment to send with information e-mail:<br>'
171         '  <input type="text" name="comment" size="80"><br>'
172         '  <input type="submit" value="create subuser and send e-mail">'
173       ));
174     }
175     pq(qq(
176       '  <p><hr><p>'
177       '  <a href="/fuc?akey=$akey">Manage your subusers and groups</a>'
178       '  <p><hr><p>'
179       '  <a href="/fuc?ab=load&akey=$akey">Edit your address book</a>'
180     ));
181     pq(qq(
182       '  <p><hr><p>'
183       '  <a href="/fuc?disclaimer=CHANGE&akey=$akey">'
184       '  Change the disclaimer</a> to be sent with notification e-mail.'
185     ));
186   }
187   pq(qq(
188     '  <p><hr><p>'
189     '  <a href="/fuc?encryption=CHANGE&akey=$akey">'
190     '  (De)activate e-mail encryption</a>.'
191   )) if -s "$ENV{HOME}/.gnupg/pubring.gpg";
192   if ((readlink "$user/\@NOTIFICATION"||'') =~ /short/i) {
193     pq(qq(
194       '  <p><hr><p>'
195       '  Get <a href="/fuc?notification=detailed&akey=$akey">detailed</a> notification e-mails (current setting: <em>brief</em>).'
196     ));
197   } else {
198     pq(qq(
199       '  <p><hr><p>'
200       '  Get <a href="/fuc?notification=short&akey=$akey">brief</a> notification e-mails (current setting: <em>detailed</em>).'
201     ));
202   }
203   if ((readlink "$user/\@REMINDER"||'') =~ /no/i) {
204     pq(qq(
205       '  <p><hr><p>'
206       '  Get <a href="/fuc?reminder=yes&akey=$akey">reminder</a> notification e-mails (current setting: <em>no reminders</em>).'
207     ));
208   } else {
209     pq(qq(
210       '  <p><hr><p>'
211       '  Get <a href="/fuc?reminder=no&akey=$akey">no reminder</a> notification e-mails (current setting: <em>send reminders</em>).'
212     ));
213   }
214   if (-e "$user/\@MIME") {
215     pq(qq(
216       '  <p><hr><p>'
217       '  <a href="/fuc?mime=no&akey=$akey">Save</a> files after download (current setting: <em>display</em>).'
218     ));
219   } else {
220     pq(qq(
221       '  <p><hr><p>'
222       '  <a href="/fuc?mime=yes&akey=$akey">Display</a> files when downloading with web browser (current setting: <em>save</em>).'
223     ));
224   }
225   pq(qq(
226     '  <p><hr><p>'
227     '  <a href="/fup?akey=$akey">Back to fup (upload page)</a>'
228     '</form>'
229   ));
230   print &logout;
231   print "</body></html>\n";
232   exit;
233 }
234
235 my $login = -x "$FEXHOME/login" ? 'login' : 'fup';
236 nvt_print(
237   "HTTP/1.1 302 Found",
238   "Location: $ENV{PROTO}://$ENV{HTTP_HOST}/$login",
239   'Expires: 0',
240   'Content-Length: 0',
241   ''
242 );
243 &reexec;