X-Git-Url: https://git.treefish.org/fex.git/blobdiff_plain/7fa382617fbaccc0ce522b2b3adbbee9db5ad227..20160328:/cgi-bin/fur?ds=sidebyside diff --git a/cgi-bin/fur b/cgi-bin/fur index 3d91f55..bca85af 100755 --- a/cgi-bin/fur +++ b/cgi-bin/fur @@ -5,12 +5,10 @@ # Author: Ulli Horlacher # -use CGI qw(:standard); -use CGI::Carp qw(fatalsToBrowser); -use Fcntl qw(:flock :seek :mode); +BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 } -$CGI::LIST_CONTEXT_WARN = 0; -$CGI::LIST_CONTEXT_WARN = 0; +use utf8; +use Fcntl qw(:flock :seek :mode); # import from fex.ph our (@local_hosts,@local_domains,@local_rhosts,@local_rdomains); @@ -18,7 +16,7 @@ our (@registration_hosts,@registration_domains); our ($usage_conditions); # import from fex.pp -our ($mdomain,$logdir,$spooldir,$fra,$hostname,$sendmail,$admin,$bcc); +our ($mdomain,@logdir,$spooldir,$fra,$hostname,$sendmail,$admin,$bcc); our $error = "F*EX user registration ERROR"; @@ -33,7 +31,7 @@ die "$0: no $FEXLIB\n" unless -d $FEXLIB; # load common code, local config: $HOME/lib/fex.ph require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n"; -my $log = "$logdir/fur.log"; +my $log = 'fur.log'; my $head = "$ENV{SERVER_NAME} F*EX user registration"; chdir $spooldir or die "$spooldir - $!\n"; @@ -49,10 +47,20 @@ unless (@local_domains or @local_rdomains) { ); } +unless (@local_hosts and ipin($ra,@local_hosts) or + @local_rhosts and ipin($ra,@local_rhosts)) { + html_error($error, + "Registrations from your host ($ra) are not allowed.", + "Contact $ENV{SERVER_ADMIN} for details." + ); +} + # look for CGI parameters -foreach my $v (param) { - my $vv = despace(param($v)); - debuglog("Param: $v=\"$vv\""); +our %PARAM; +&parse_parameters; +foreach my $v (keys %PARAM) { + my $vv = despace($PARAM{$v}); + # debuglog("Param: $v=\"$vv\""); $CASE = $v =~ /^user$/i ? $user = normalize_address($vv): $v =~ /^exuser$/i ? $exuser = normalize_address($vv): @@ -82,9 +90,9 @@ if ($confirm) { } # if (-f "$user/@") { http_die("$user is already activated") } open $user,'>',"$user/@" or http_die("open $user/@ - $!\n"); - print {$user} $id,"\n"; + print {$user} $id,"\n"; close $user or http_die("close $user/@ - $!\n"); - + http_header("200 OK"); print html_header($head); my $url = "$ENV{PROTO}://$ENV{HTTP_HOST}/fup/" . b64("from=$user&id=$id"); @@ -97,11 +105,11 @@ if ($confirm) { '

' 'or you can use:' '

' - ' + '
' ' ' ' ' ' ' - '
URL:$ENV{PROTO}://$ENV{HTTP_HOST}/fup/
Sender:$user
auth-ID:$id
+ '' '' )); furlog("confirm: account $user created"); @@ -118,7 +126,7 @@ unless ($user or $exuser or $demouser) { ' accept-charset="UTF-8"' ' enctype="multipart/form-data">' )); - + if (@local_domains and @local_hosts and ipin($ra,@local_hosts)) { $reg = $ra; if (grep(/\*/,@local_domains)) { @@ -144,8 +152,8 @@ unless ($user or $exuser or $demouser) { )); } } - - if (@local_rdomains and @local_rhosts and + + if (@local_rdomains and @local_rhosts and (not @registration_hosts or ipin($ra,@registration_hosts))) { print "

or

\n" if $reg; $reg = $ra; @@ -155,7 +163,7 @@ unless ($user or $exuser or $demouser) { '

' )); } - + if (@demo) { print "

or

\n" if $reg; $reg = $ra; @@ -167,7 +175,7 @@ unless ($user or $exuser or $demouser) { '

' )); } - + if ($reg) { pq(qq( '

' @@ -188,7 +196,7 @@ unless ($user or $exuser or $demouser) { pq(qq( '' '

' - 'User types overview' + 'User types overview' '' )); } else { @@ -238,7 +246,7 @@ if ($exuser) { $mydomains .= "|$mdomain" if $mdomain; $user .= '@'.$domain if $domain and $user !~ /@/; # $user .= '@'.$mdomain if $mdomain and $user !~ /@/; - + unless (@local_hosts and ipin($ra,@local_hosts)) { html_error($error, "Registrations from your host ($ra) are not allowed.", @@ -268,7 +276,7 @@ if (-f "$user/@") { $error, "you are already registered". " (I have lost my auth-ID)" - ); + ); } unless (-d $user) { @@ -289,7 +297,7 @@ if ($exuser) { print {$rf} "\@LOCAL_RHOSTS\n"; close $rf; if (open $user,'>',"$user/.auto") { - print {$user} "fur:external\n"; + print {$user} "fur:external\n"; close $user; } } elsif ($demouser) { @@ -299,13 +307,13 @@ if ($exuser) { printf {$quota} "sender:%d\n",$demo[0]; close $quota; if (open $user,'>',"$user/.auto") { - print {$user} "fur:demo\n"; + print {$user} "fur:demo\n"; close $user; } open $demouser,'>',"$demouser/.demo" and close $demouser; } else { if (open $user,'>',"$user/.auto") { - print {$user} "fur:internal\n"; + print {$user} "fur:internal\n"; close $user; } } @@ -314,7 +322,7 @@ $id = randstring(6); if ("@local_domains" eq "*") { open $id,'>',"$user/@" or http_die("open $user/@ - $!\n"); - print {$id} $id,"\n"; + print {$id} $id,"\n"; close $id or http_die("close $user/@ - $!\n"); http_header("200 OK"); print html_header($head); @@ -334,12 +342,12 @@ if ("@local_domains" eq "*") { # from fexsend if ($verify eq 'no') { open $id,'>',"$user/@" or http_die("open $user/@ - $!\n"); - print {$id} $id,"\n"; + print {$id} $id,"\n"; close $id or http_die("close $user/@ - $!\n"); http_header("200 OK",'Content-Type: text/plain'); print "$ENV{PROTO}://$ENV{HTTP_HOST}/fup?from=$user&ID=$id\n"; furlog("direct: account $user created"); - if ($bcc and open my $mail,"|$sendmail '$bcc' 2>>$log") { + if ($bcc and open my $mail,"|$sendmail '$bcc' 2>>$logdir[0]/$log") { pq($mail,qq( 'From: fex' 'To: $bcc' @@ -384,7 +392,7 @@ close $mail or http_die("cannot send mail - $!\n"); http_header("200 OK"); print html_header($head); print "confirmation e-mail has been sent to $user\n"; -print "\n"; +print "\n"; furlog("confirmation request mailed to $user"); exit; @@ -392,17 +400,13 @@ exit; # standard log sub furlog { my $msg = "@_"; - + $msg =~ s/\n/ /g; $msg =~ s/\s+$//; - - if (open $log,'>>',$log) { - flock $log,LOCK_EX; - seek $log,0,SEEK_END; - printf {$log} "%s [%s_%s] %s %s\n", - isodate(time),$$,$ENV{REQUESTCOUNT},$fra,$msg; - close $log; - } + $msg = sprintf "%s [%s_%s] %s %s\n", + isodate(time),$$,$ENV{REQUESTCOUNT},$fra,$msg; + + writelog($log,$msg); } sub normalize_address {