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