Original release 20150729

[fex.git] / lib / fex.pp

diff --git a/lib/fex.pp b/lib/fex.pp
index 352b41298ebc5c47194e26c4368fdae9d94c0c77..bd7ed98b8c1da2fce22eb65ddad6ee44b0da7f0c 100644 (file)
--- a/lib/fex.pp
+++ b/lib/fex.pp
@@ -75,9 +75,6 @@ if ($FHS) {
 # allowed download managers (HTTP User-Agent)
 $adlm = '^(Axel|fex)';
 
 # allowed download managers (HTTP User-Agent)
 $adlm = '^(Axel|fex)';
 

-# allowed multi download recipients
-$amdl = '^(anonymous|_fexmail_)';
-

 # local config
 require "$FEXLIB/fex.ph" or die "$0: cannot load $FEXLIB/fex.ph - $!";
 
 # local config
 require "$FEXLIB/fex.ph" or die "$0: cannot load $FEXLIB/fex.ph - $!";
 


@@ -89,6 +86,13 @@ $debug               = 0 if $debug           =~ /no/i;
 @logdir = ($logdir) unless @logdir;
 $logdir = $logdir[0];
 
 @logdir = ($logdir) unless @logdir;
 $logdir = $logdir[0];
 

+# allowed multi download recipients: from any ip, any times
+if (@mailing_lists) {
+  $amdl = '^('.join('|',map { quotewild($_) } @mailing_lists).')$';
+} else {
+  $amdl = '^-$';
+}
+

 # check for name based virtual host
 $vhost = vhost($ENV{'HTTP_HOST'});
 
 # check for name based virtual host
 $vhost = vhost($ENV{'HTTP_HOST'});
 


@@ -154,18 +158,20 @@ $default_locale ||= 'english';
 # $durl is first default fop download URL
 # @durl is optional mandatory fop download URL list (from fex.ph)
 unless ($durl) {
 # $durl is first default fop download URL
 # @durl is optional mandatory fop download URL list (from fex.ph)
 unless ($durl) {

+  my $host = '';
+  my $port = 80;
+  my $xinetd = '/etc/xinetd.d/fex';
+  

   if (@durl) {
     $durl = $durl[0];
   } elsif ($ENV{HTTP_HOST} and $ENV{PROTO}) {
   if (@durl) {
     $durl = $durl[0];
   } elsif ($ENV{HTTP_HOST} and $ENV{PROTO}) {

-    my $host = '';
-    my $port = 0;

   
     ($host,$port) = split(':',$ENV{HTTP_HOST}||'');
     $host = $hostname;
   
     unless ($port) {
       $port = 80;
   
     ($host,$port) = split(':',$ENV{HTTP_HOST}||'');
     $host = $hostname;
   
     unless ($port) {
       $port = 80;

-      if (open my $xinetd,'<',"/etc/xinetd.d/fex") {
+      if (open $xinetd,$xinetd) {

         while (<$xinetd>) {
           if (/^\s*port\s*=\s*(\d+)/) {
             $port = $1;
         while (<$xinetd>) {
           if (/^\s*port\s*=\s*(\d+)/) {
             $port = $1;


@@ -183,9 +189,23 @@ unless ($durl) {
       $durl = "$ENV{PROTO}://$host:$port/fop";
     }
   } else {
       $durl = "$ENV{PROTO}://$host:$port/fop";
     }
   } else {

-    $durl = "http://$hostname/fop";
+    if (open $xinetd,$xinetd) {
+      while (<$xinetd>) {
+        if (/^\s*port\s*=\s*(\d+)/) {
+          $port = $1;
+          last;
+        }
+      }
+      close $xinetd;
+    }
+    if ($port == 80) {
+      $durl = "http://$hostname/fop";
+    } else {
+      $durl = "http://$hostname:$port/fop";
+    }

   }
 }
   }
 }

+@durl = ($durl) unless @durl;

 
 
 sub reexec {
 
 
 sub reexec {


@@ -699,8 +719,7 @@ sub checkforbidden {
   return $a if -d "$spooldir/$a"; # ok, if user already exists
   if (@forbidden_recipients) {
     foreach (@forbidden_recipients) {
   return $a if -d "$spooldir/$a"; # ok, if user already exists
   if (@forbidden_recipients) {
     foreach (@forbidden_recipients) {

-      $fr = quotemeta;
-      $fr =~ s/\\\*/.*/g; # allow wildcard *
+      $fr = quotewild($_);

       # skip public recipients
       if (@public_recipients) {
         foreach $pr (@public_recipients) {
       # skip public recipients
       if (@public_recipients) {
         foreach $pr (@public_recipients) {


@@ -1290,6 +1309,14 @@ sub mtime {
 }
 
 
 }
 
 

+# wildcard * to perl regexp
+sub quotewild {
+  local $_ = quotemeta shift;
+  s/\\\*/.*/g; # allow wildcard *
+  return $_;
+}
+
+

 # extract locale functions into hash of subroutine references
 # e.g. \&german ==> $notify{german}
 sub locale_functions {
 # extract locale functions into hash of subroutine references
 # e.g. \&german ==> $notify{german}
 sub locale_functions {


@@ -1353,10 +1380,12 @@ sub notify_locale {
   );
 }
 
   );
 }
 

-### locale functions ###
-# will be extracted by install process and saved in $FEXHOME/lib/lf.pl
-# you cannot modify them here without re-installing!
+########################### locale functions ###########################
+# Will be extracted by install process and saved in $FEXHOME/lib/lf.pl #
+# You cannot modify them here without re-installing!                   #
+########################################################################

 
 

+# locale function!

 sub notify {
   # my ($status,$dkey,$filename,$keep,$warn,$comment,$autodelete) = @_;
   my %P = @_;
 sub notify {
   # my ($status,$dkey,$filename,$keep,$warn,$comment,$autodelete) = @_;
   my %P = @_;


@@ -1579,6 +1608,7 @@ sub notify {
 }
 
 
 }
 
 

+# locale function!

 sub reactivation {
   my ($expire,$user) = @_;
   my $fexsend = "$FEXHOME/bin/fexsend";
 sub reactivation {
   my ($expire,$user) = @_;
   my $fexsend = "$FEXHOME/bin/fexsend";