]> git.treefish.org Git - fex.git/blobdiff - htdocs/download/fexsend
Original release 20150826
[fex.git] / htdocs / download / fexsend
index 607d1391f9de05c5362701ae806199a02d6424a6..e746b669a958495748effb2b305c448a94ec211b 100755 (executable)
@@ -37,7 +37,7 @@ our ($tpid,$frecipient);
 our ($FEXID,$FEXXX,$HOME);
 our (%alias);
 our $chunksize = 0;
-our $version = 20150120;
+our $version = 20150826;
 our $_0 = $0;
 our $DEBUG;
 
@@ -81,10 +81,10 @@ my $atype = '';             # archive type
 my $fexcgi;            # F*EX CGI URL
 my @files;             # files to send
 my %AB = ();           # server based address book
-my ($server,$port,$sid);
+my ($server,$port,$sid,$https);
 my $proxy = '';
 my $proxy_prefix = '';
-my $features = ''; 
+my $features = '';
 my $timeout = 30;      # server timeout
 my $fexlist = "$tmpdir/fexlist";
 my ($usage,$hints);
@@ -108,7 +108,7 @@ usage: $0 [options] file(s) [@] recipient(s)
    or: $0 -x \# [-C -k -D -K -S]
 options: -v           verbose mode
          -d           delete file on fex server
-         -c           compress file
+         -c           compress file with gzip
          -g           encrypt file with gpg
          -m limit     limit throughput (kB/s)
          -i tag       use ID data [tag] from ID file
@@ -142,18 +142,18 @@ EOD
 
   $hints = <<EOD;
 $0 hints and more options:
-  
+
 usage: $0 [options] file recipient(s)
 
 Recipient can be a comma separated address list. Example:
   $0 big.file framstag\@rus.uni-stuttgart.de,webmaster\@flupp.org
 
-Recipient can be an alias from your server address book 
+Recipient can be an alias from your server address book
 (use "$0 -A" to edit it). Example:
   $0 big.file framstag
 
 Recipient can be a SKEY URL, which you have received from a regular F*EX user.
-When using this URL you are a subuser of this full user and the file will be 
+When using this URL you are a subuser of this full user and the file will be
 sent to him. Example:
   $0 big.file http://fex.rus.uni-stuttgart.de/fup?skey=4285f8cdd881626524fba686d5f0a83a
 
@@ -162,10 +162,10 @@ Using this URL you are a member of his group and the file will be sent to all
 members of this group. Example:
   $0 big.file http://fex.rus.uni-stuttgart.de/fup?gkey=50d26547b1e8c1110beb8748fc1d9444
 
-When you use "FEX-URL/anonymous" as recipient and your F*EX administrator has 
+When you use "FEX-URL/anonymous" as recipient and your F*EX administrator has
 allowed anonymous upload for your IP address then no auth-ID is needed.
-    
-"." as recipient means fex to yourself and show immediately the download URL 
+
+"." as recipient means fex to yourself and show immediately the download URL
 (no notification e-mail will be sent). Example:
   $0 software.tar .
 
@@ -188,8 +188,8 @@ Additional special options:
   -F activates female mode
   -U show authorized URL
   -+ is an undocumented feature - test it :-)
-    
-To manage your subuser and groups or forward or redirect files, use a 
+
+To manage your subuser and groups or forward or redirect files, use a
 webbrowser with the URL from "$0 -U", e.g.:  firefox \$($0 -U)
 
 If you want to copy-forward an already uploaded file to another recipient,
@@ -199,6 +199,10 @@ and then copy-forward it with:
   $0 -b # other\@address
 Where # is the file number.
 
+You can list an uploaded file in more detail with
+  $0 -l #
+Where # is the file number.
+
 If you want to modify the keep time, comment or auto-delete behaviour of an
 already uploaded file then you first have to query the file number with:
   $0 -l
@@ -207,12 +211,12 @@ and then for example set the keep time to 30 days with:
 Where # is the file number.
 
 With option -a you can send several files or whole directories within a single
-archive file. The archive types tar and tgz are build on-the-fly (streaming) 
+archive file. The archive types tar and tgz are build on-the-fly (streaming)
 whereas archive types zip and 7z need a temporary archive file on local disk.
 
 With option -s you can send any data coming from a pipe (STDIN) as a file
 without wasting local disc space.
+
 With option -X you can specify any parameter, e.g.: -X autodelete=yes
 
 For HTTPS you can set the environment variables:
@@ -221,17 +225,17 @@ SSLVERSION=TLSv1            # this is the default
 SSLCAPATH=/etc/ssl/certs    # path to trusted (root) certificates
 SSLCAFILE=/etc/ssl/cert.pem # file with trusted (root) certificates
 SSLCIPHERLIST=HIGH:!3DES    # see http://www.openssl.org/docs/apps/ciphers.html
-  
+
 Partner program xx is an internet clipboard. See: xx -h
-  
+
 Partner program fexget is for downloading. See: fexget -h
-  
-For temporary usage of a HTTP proxy use: 
+
+For temporary usage of a HTTP proxy use:
   $0 -P your_proxy:port:chunksize_in_MB file recipient
 Example:
   $0 -P wwwproxy.uni-stuttgart.de.de:8080:1024 4GB.tar .
-  
-For temporary usage of an alternative F*EX server or user use: 
+
+For temporary usage of an alternative F*EX server or user use:
   FEXID="FEXSERVER USER AUTHID" $0 file recipient
 Example:
   FEXID="fex.flupp.org gaga\@flupp.org blubb" $0 big.file framstag\@rus.uni-stuttgart.de
@@ -247,12 +251,12 @@ You can define aliases (and optional fexsend options) in \$HOME/.fex/config.pl:
 fexsend also respects aliases in $HOME/.mutt/aliases
 The alias priority is (descending):
 \$HOME/.fex/config.pl
-\$HOME/.mutt/aliases 
-fexserver address book  
+\$HOME/.mutt/aliases
+fexserver address book
 
 In \$HOME/.fex/config.pl you can also set the SSL* environment variables and the
 \$opt_* variables, e.g.:
-  
+
 \$ENV{SSLVERSION} = 'TLSv1';
 \${'opt_+'} = 1;
 \$opt_m = 200;
@@ -266,7 +270,7 @@ my @rcamel = (
  *=(  __  /
     \\\\/\\\\/
 ',
-'\e[A    \\\\/\\\\/ 
+'\e[A    \\\\/\\\\/
 ',
 '\e[A   //\\\\//\\\\
 ');
@@ -310,18 +314,18 @@ if ($xx) {
   $opt_u = $opt_f = $opt_a = $opt_C = $opt_i = $opt_b = $opt_P = $opt_X = '';
   $opt_s = $opt_r = '';
   $_ = "$fexhome/config.pl"; require if -f;
-  getopts('hHvcdognVDKlILUARWMFzZqQS@!+./r:m:k:u:f:a:s:C:i:b:P:x:X:N:=:#:') 
+  getopts('hHvcdognVDKlILUARWMFzZqQS@!+./r:m:k:u:f:a:s:C:i:b:P:x:X:N:=:#:')
     or die $usage;
 
   if ($opt_H) {
     print $hints;
     exit;
   }
-  
+
   if ($opt_V) {
     print "Version: $version\n";
   }
-  
+
   if ($opt_K and $opt_D) {
     die "$0: you cannot use both options -D and -K\n";
   }
@@ -348,7 +352,7 @@ if ($xx) {
   }
 
   # $opt_C is COMMENT command in F*EX protocol
-  $opt_C =    
+  $opt_C =
     ($opt_d)           ? 'DELETE':
     ($opt_l or $opt_L) ? 'LIST':
     ($opt_Q)           ? 'CHECKQUOTA':
@@ -357,8 +361,8 @@ if ($xx) {
     ($opt_z)           ? 'SENDLOG':
     (${'opt_!'})       ? 'FOPLOG':
   $opt_C;
-  
-  $opt_D =     
+
+  $opt_D =
     ($opt_D) ? 'DELAY':
     ($opt_K) ? 'NO':
   $opt_D;
@@ -381,7 +385,7 @@ if ($opt_R) {
 
 die $usage if $opt_m and $opt_m !~ /^\d+/;
 
-if ($opt_P) { 
+if ($opt_P) {
   if ($opt_P =~ /^([\w.-]+:\d+)(:(\d+))?/) {
     $proxy = $1;
     $chunksize = $3 || 0;
@@ -415,7 +419,7 @@ if ($xx) {
       unlink $idf.'xx';
     }
   }
-  
+
   # special xx ID?
   if ($FEXXX = $ENV{FEXXX}) {
     $FEXXX = decode_b64($FEXXX) if $FEXXX !~ /\s/;
@@ -430,7 +434,7 @@ if ($xx) {
     }
     close $idf;
   }
-  
+
 } else {
 
   # alternativ ID?
@@ -449,7 +453,7 @@ if ($xx) {
 }
 
 if ($opt_I) {
-  if ($xx) { &show_id } 
+  if ($xx) { &show_id }
   else     { &init_id }
   exit;
 }
@@ -468,15 +472,15 @@ if (@ARGV > 1 and $ARGV[-1] =~ /(^|\/)anonymous/) {
 } else {
 
   $fexcgi = $opt_u if $opt_u;
-  
+
   if (not -e $idf and not ($fexcgi and $from and $id)) {
     die "$0: no ID file $idf found, use \"fexsend -I\" to create it\n";
   }
-  
+
   unless ($fexcgi) {
     die "$0: no FEX URL found, use \"$0 -u URL\" or \"$0 -I\"\n";
   }
-  
+
   unless ($from and $id) {
     die "$0: no sender found, use \"$0 -f FROM:ID\" or \"$0 -I\"\n";
   }
@@ -494,9 +498,10 @@ $port = 80;
 $port = 443 if $server =~ s{https://}{};
 $port = $1  if $server =~ s/:(\d+)//;
 
-if (0 and $port == 443) {
-  $opt_s and die "$0: cannot use -s with https due to stunnel bug\n"; 
-  $opt_g and die "$0: cannot use -g with https due to stunnel bug\n"; 
+if ($port == 443) {
+  # $opt_s and die "$0: cannot use -s with https due to stunnel bug\n";
+  # $opt_g and die "$0: cannot use -g with https due to stunnel bug\n";
+  $https = $port;
 }
 
 $server =~ s{http://}{};
@@ -520,7 +525,7 @@ if ($xx) {
     $transferfile = "$tmpdir/xx:$1";
     shift @ARGV;
   }
-  open my $lock,'>>',$transferfile 
+  open my $lock,'>>',$transferfile
     or die "$0: cannot write $transferfile - $!\n";
   flock($lock,LOCK_EX|LOCK_NB)
     or die "$0: $transferfile is locked by another process\n";
@@ -531,7 +536,7 @@ if ($xx) {
     &send_xx($transferfile);
   }
   exit;
-} 
+}
 
 # regular fexsend
 
@@ -555,16 +560,16 @@ unless ($skey or $gkey or $anonymous) {
 }
 
 if    ($opt_V and not @ARGV)           { exit }
-if    ($opt_f)                                 { &forward } 
-elsif ($opt_x)                                 { &modify } 
-elsif ($opt_N)                                 { &renotify } 
-elsif ($opt_Q)                                 { &query_quotas } 
-elsif ($opt_S)                                 { &query_settings } 
-elsif ($opt_l or $opt_L)               { &list } 
-elsif ($opt_U)                         { &show_URL } 
-elsif ($opt_z or $opt_Z or ${'opt_!'}) { &get_log } 
+if    ($opt_f)                                 { &forward }
+elsif ($opt_x)                                 { &modify }
+elsif ($opt_N)                                 { &renotify }
+elsif ($opt_Q)                                 { &query_quotas }
+elsif ($opt_S)                                 { &query_settings }
+elsif ($opt_l or $opt_L)               { &list }
+elsif ($opt_U)                         { &show_URL }
+elsif ($opt_z or $opt_Z or ${'opt_!'}) { &get_log }
 elsif ($opt_A)                         { edit_address_book($from) }
-elsif (${'opt_@'})                     { &show_address_book } 
+elsif (${'opt_@'})                     { &show_address_book }
 elsif ($opt_d and $anonymous)          { &purge }
 elsif ($opt_d and $ARGV[-1] =~ /^\d+$/)        { &delete }
 else                                   { &send_fex }
@@ -576,14 +581,14 @@ exit;
 sub init_id {
   my $tag;
   my $proxy = '';
-  
+
   if ($opt_I) {
     $tag = shift @ARGV;
     die $usage if @ARGV;
   }
-  
+
   $fexcgi = $from = $id = '';
-  
+
   unless (-d $fexhome) {
     mkdir $fexhome,0700 or die "$0: cannot create FEXHOME $fexhome - $!\n";
   }
@@ -616,7 +621,7 @@ sub init_id {
   }
 
   if ($tag and $tag eq '.') { exec $ENV{EDITOR}||'vi',$idf }
-  
+
   if ($tag) { print "F*EX server URL for [$tag]: " }
   else      { print "F*EX server URL: " }
   $fexcgi = <STDIN>;
@@ -625,8 +630,10 @@ sub init_id {
   if ($fexcgi =~ /\?/) {
     $from = $1 if $fexcgi =~ /\bfrom=(.+?)(&|$)/i;
     $id   = $1 if $fexcgi =~ /\bid=(.+?)(&|$)/i;
-    $skey = $1 if $fexcgi =~ /\bskey=(.+?)(&|$)/i;
-    $gkey = $1 if $fexcgi =~ /\bgkey=(.+?)(&|$)/i;
+    # $skey = $1 if $fexcgi =~ /\bskey=(.+?)(&|$)/i;
+    # $gkey = $1 if $fexcgi =~ /\bgkey=(.+?)(&|$)/i;
+    die "$0: cannot use GKEY URL in ID file\n" if $fexcgi =~ /gkey=/i;
+    die "$0: cannot use SKEY URL in ID file\n" if $fexcgi =~ /skey=/i;
     $fexcgi =~ s/\?.*//;
   }
   unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) {
@@ -636,11 +643,11 @@ sub init_id {
   print "proxy address (hostname:port or empty if none): ";
   $proxy = <STDIN>;
   $proxy =~ s/[\s\n]//g;
-  if ($proxy =~ /^[\w.-]+:\d+$/) { 
+  if ($proxy =~ /^[\w.-]+:\d+$/) {
     $proxy = "!$proxy";
-  } elsif ($proxy =~ /\S/) { 
+  } elsif ($proxy =~ /\S/) {
     die "wrong proxy address format\n";
-  } else { 
+  } else {
     $proxy = "";
   }
   if ($proxy) {
@@ -776,12 +783,12 @@ sub send_xx {
   my $transferfile = shift;
   my $file = '';
   my (@r,@tar);
-  
+
   $SIG{PIPE} = $SIG{INT} = sub {
     unlink $transferfile;
     exit 3;
   };
-  
+
   if ($0 eq 'xxx') { @tar = qw'tar -cv' }
   else             { @tar = qw'tar -cvz' }
 
@@ -791,7 +798,7 @@ sub send_xx {
       shelldo("cat >> $transferfile");
     } elsif (@ARGV) {
       print "making tar transfer file $transferfile :\n";
-      # single file? then add this directly 
+      # single file? then add this directly
       if (scalar @ARGV == 1) {
         my ($dir,$file);
         # strip path if not ending with /
@@ -824,10 +831,10 @@ sub send_xx {
   }
 
   die "$0: no transfer file\n" unless -s $transferfile;
-  
+
   serverconnect($server,$port);
   query_sid($server,$port);
-  
+
   @r = formdatapost(
     from       => $from,
     to         => $from,
@@ -836,7 +843,7 @@ sub send_xx {
     comment    => 'NOMAIL',
     autodelete => $transferfile =~ /STDFEX/ ? 'NO' : 'DELAY',
   );
-  
+
   # open P,'|w3m -T text/html -dump' or die "$0: w3m - $!\n";
   # print P @r;
   http_response(@r);
@@ -845,7 +852,7 @@ sub send_xx {
       print "wget -O- $2 | tar xvzf -\n";
     }
   }
-  
+
   unlink $transferfile;
 }
 
@@ -860,7 +867,7 @@ sub query_quotas {
     from       => $from,
     to         => $from,
     id         => $sid,
-    command    => $opt_C, 
+    command    => $opt_C,
   );
   die "$0: no response from fex server $server\n" unless @r;
   $_ = shift @r;
@@ -899,12 +906,12 @@ sub query_settings {
   print "auth-ID: $id\n";
   print "login URL: ";
   &show_URL;
-  
+
   @r = formdatapost(
     from       => $from,
     to         => $from,
     id         => $sid,
-    command    => $opt_C, 
+    command    => $opt_C,
   );
   die "$0: no response from fex server $server\n" unless @r;
   $_ = shift @r;
@@ -980,7 +987,7 @@ sub list {
     @r = formdatapost(
       from     => $from,
       to       => $opt_l ? '*' : $from,
-      command  => $opt_C, 
+      command  => $opt_C,
     );
   }
   die "$0: no response from fex server $server\n" unless @r;
@@ -989,7 +996,7 @@ sub list {
     s:HTTP/[\d\. ]+::;
     die "$0: server response: $_\n";
   }
-  
+
   # list sent files
   if ($opt_l) {
     open $fexlist,">$fexlist" or die "$0: cannot write $fexlist - $!\n";
@@ -1001,6 +1008,9 @@ sub list {
       else                              { $dkey = '' }
 #      $_ = encode_utf8($_);
       s/<.*?>//g;
+      s/&amp;/&/g;
+      s/&quot;/\"/g;
+      s/&lt;/</g;
       if (/^(to .* :)/) {
         print "\n$1\n";
         print {$fexlist} "\n$1\n";
@@ -1011,8 +1021,8 @@ sub list {
       }
     }
     close $fexlist;
-  } 
-  
+  }
+
   # list received files
   if ($opt_L) {
     foreach (@r) {
@@ -1039,12 +1049,12 @@ sub show_URL {
 sub get_log {
   my (@r);
   local $_;
-  
+
   @r = formdatapost(
     from       => $from,
     to         => $from,
     id         => $sid,
-    command    => $opt_C, 
+    command    => $opt_C,
   );
   die "$0: no response from fex server $server\n" unless @r;
   $_ = shift @r;
@@ -1061,7 +1071,7 @@ sub show_address_book {
   my (%AB,@r);
   my $alias;
   local $_;
-  
+
   %AB = query_address_book($server,$port,$from);
   foreach $alias (sort keys %AB) {
     next if $alias eq 'ADDRESS_BOOK';
@@ -1088,7 +1098,7 @@ sub delete {
   while (@ARGV) {
     $opt_d = shift @ARGV;
     die "$usage: $0 -d #\n" if $opt_d !~ /^\d+$/;
-  
+
     open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
     while (<$fexlist>) {
       if (/^to (.+\@.+) :/) {
@@ -1135,12 +1145,11 @@ sub send_fex {
   my @files = ();
   my ($data,$aname,$alias);
   my (@r,$r);
-  my $ma = $HOME.'/.mutt/aliases';
   my $t0 = time;
   my $transferfile;
   my @transferfiles;
   local $_;
-  
+
   if ($from =~ /^SUBUSER|GROUPMEMBER$/) {
     $to = '_';
   } else {
@@ -1176,7 +1185,7 @@ sub send_fex {
     }
   }
   @to = split(',',lc($to));
-  
+
   die $usage unless @ARGV or $opt_a or $opt_s;
   die $usage if $opt_s and @ARGV;
 
@@ -1203,9 +1212,9 @@ sub send_fex {
     }
   } elsif ($public) {
   } else {
-    
+
     query_sid($server,$port);
-    
+
     if ($from eq 'SUBUSER') {
       $skey = $sid;
       # die "skey=$skey\nid=$id\nsid=$sid\n";
@@ -1214,7 +1223,7 @@ sub send_fex {
     if ($from eq 'GROUPMEMBER') {
       $gkey = $sid;
     }
-    
+
     if ($to eq '.') {
       @to = ($from);
       $opt_C ||= 'NOMAIL';
@@ -1248,45 +1257,25 @@ sub send_fex {
           }
         }
         # alias in server address book?
-        elsif ($AB{$to}) {  
-          # do not substitute alias with expanded addresses because then 
+        elsif ($AB{$to}) {
+          # do not substitute alias with expanded addresses because then
           # keep and autodelete options from address book will get lost
           # $to = $AB{$to};
-        } 
+        }
         # look for mutt aliases
-        elsif ($to !~ /@/ and $to ne $from and open $ma,$ma) {
-          $alias = $to;
-          while (<$ma>) {
-            if (/^alias \Q$to\E\s/i) {
-              chomp;
-              s/\s*#.*//;
-              s/\(.*?\)//;
-              s/\s+$//;
-              s/.*\s+//;
-              s/[<>]//g;
-              if (/,/) {
-                warn "$0: ignoring mutt multi-alias $to = $alias\n";
-                last;
-              }
-              if (/@/) {
-                $alias = $_;
-                warn "$0: found mutt alias $to = $alias\n";
-                last;
-              }
-            }
-          }
-          close $ma;
-          $to = $alias;
+        elsif ($to !~ /@/ and $to ne $from) {
+          $to = get_mutt_alias($to);
         }
       }
     }
-  
+
     $to = join(',',grep /./,@to) or exit;
-    warn "Server/User: $fexcgi/$from\n" unless $opt_q;
-  
+    warn "Server/User: $fexcgi/$from\n" unless $opt_q;
+
     if (
       not $skey and not $gkey
-      and $features =~ /CHECKRECIPIENT/ 
+      and $from ne $to
+      and $features =~ /CHECKRECIPIENT/
       and $opt_C !~ /^(DELETE|LIST|RECEIVEDLOG|SENDLOG|FOPLOG)$/
     ) {
       checkrecipient($from,$to);
@@ -1382,25 +1371,25 @@ sub send_fex {
     } else {
       die "$0: unknown archive format \"$atype\"\n";
     }
-    
+
     if (@transferfiles) {
-      
+
       # error in making transfer archive?
       if ($?) {
         unlink @transferfiles;
         die "$0: $! - aborting upload\n";
       }
-      
+
       # maybe timeout, so make new connect
       if (time-$t0 >= $timeout) {
         serverconnect($server,$port);
         query_sid($server,$port) unless $anonymous;
       }
-      
+
     }
-    
+
   } else {
-    
+
     unless (@ARGV) {
       if ($windoof) {
         &inquire;
@@ -1408,7 +1397,7 @@ sub send_fex {
         die $usage;
       }
     }
-    
+
     foreach (@ARGV) {
       my $file = $_;
       unless ($opt_d) {
@@ -1433,7 +1422,7 @@ sub send_fex {
       }
     }
   }
-  
+
   foreach my $file (@files) {
     sleep 1;    # do not overrun server!
     unless (-s $file or $opt_d or $opt_a or $opt_s) {
@@ -1448,7 +1437,7 @@ sub send_fex {
       file             => $file,
       keep             => $opt_k,
       comment          => $opt_C,
-      autodelete       => $opt_D, 
+      autodelete       => $opt_D,
     );
 
     if (not @r or not grep /\w/,@r) {
@@ -1479,16 +1468,27 @@ sub send_fex {
         }
         if (/^(X-)?(Location.*)/i) {
           $location = $2;
-          if ($from eq $to or $from =~ /^\Q$to\E@/i 
+          if ($from eq $to or $from =~ /^\Q$to\E@/i
               or $nomail or $anonymous or $nonot) {
             print "$recipient\n";
             print "$location\n";
           }
         }
       }
+      unless ($opt_d or $location) {
+        if (scalar(@r) == 1) {
+          die "$0: server error: @r\n";
+        } else {
+          if ($r[0] !~ /HTTP.1.. 2/ and $r[0] =~ /HTTP.[\s\d.]+(.+)/) {
+            die "$0: server error: $1\n";
+          } else {
+            die "$0: server error:\n".join("\n",@r)."\n";
+          }
+        }
+      }
     }
   }
-  
+
   # delete transfer tmp file
   unlink $transferfile if $transferfile;
 }
@@ -1497,9 +1497,9 @@ sub send_fex {
 sub forward {
   my (@r);
   my ($to,$n,$dkey,$file,$req);
-  my $status = 1;
+  my ($status,$fp);
   local $_;
-  
+
   # look for single @ in arguments
   for (my $i=1; $i<$#ARGV; $i++) {
     if ($ARGV[$i] eq '@') {
@@ -1512,6 +1512,9 @@ sub forward {
   # if ($windoof and not @ARGV) { &inquire }
   $to = pop @ARGV or die $usage;
   $to = $from if $to eq '.';
+  if ($to !~ /@/ and $to ne $from) {
+    $to = get_mutt_alias($to);
+  }
 
   open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
   while (<$fexlist>) {
@@ -1526,7 +1529,7 @@ sub forward {
     }
   }
   close $fexlist;
-  
+
   unless ($n) {
     die "$0: file #$opt_f not found in fexlist\n";
   }
@@ -1535,7 +1538,7 @@ sub forward {
 
   serverconnect($server,$port);
   query_sid($server,$port);
-  
+
   $req = "GET $proxy_prefix/fup?"
         ."from=$from&ID=$sid&to=$to&dkey=$dkey&command=FORWARD";
   $req .= "&comment=$opt_C"    if $opt_C;
@@ -1545,18 +1548,14 @@ sub forward {
   $req .= " HTTP/1.1";
   sendheader("$server:$port",$req);
   http_response();
-  while (<$SH>) { 
-    if ($opt_v) {
-      print;
-      $status = 0 if /\Q"$file"/;
-    } else {
-      if (/\Q"$file"/) {
-        print;
-        $status = 0;
-      }
-    }
+  $fp = $file;
+  $fp =~ s/[^\w_.-]/.+/g; # because of UTF8 filename
+  $status = 1;
+  while (<$SH>) {
+    $status = 0 if /"$fp"/;
+    print if $opt_v or /"$fp"/;
   }
-  
+
   if ($status) {
     die "$0: server failed, rerun command with option -v\n";
   }
@@ -1580,7 +1579,7 @@ sub renotify {
     }
   }
   close $fexlist;
-  
+
   unless ($n) {
     die "$0: file #$opt_N not found in fexlist\n";
   }
@@ -1589,7 +1588,7 @@ sub renotify {
 
   serverconnect($server,$port);
   query_sid($server,$port);
-  
+
   $req = "GET $proxy_prefix/fup?"
         ."from=$from&ID=$sid&dkey=$dkey&command=RENOTIFY"
         ." HTTP/1.1";
@@ -1604,7 +1603,7 @@ sub renotify {
       $file = $3;
     }
   }
-  
+
   if ($file) {
     print "notification e-mail for $file has been resent to $recipient\n";
   } else {
@@ -1614,7 +1613,7 @@ sub renotify {
       die "$0: server failed, rerun command with option -v\n";
     }
   }
-  
+
   exit;
 }
 
@@ -1623,10 +1622,10 @@ sub modify {
   my (@r);
   my ($n,$dkey,$file,$req);
   local $_;
-  
+
   die $usage if @ARGV;
   die $usage unless $opt_C or $opt_k or $opt_D;
-  
+
   open $fexlist,$fexlist or die "$0: $fexlist - $!\n";
   while (<$fexlist>) {
     if (/^\s*(\d+)\) (\w+) \[\d+ d\] (.+)/ and $1 eq $opt_x) {
@@ -1638,16 +1637,16 @@ sub modify {
     }
   }
   close $fexlist;
-  
+
   unless ($n) {
     die "$0: file #$opt_x not found in fexlist\n";
   }
 
   female_mode("modify file #$opt_x?") if $opt_F;
-  
+
   serverconnect($server,$port);
   query_sid($server,$port);
-  
+
   $req = "GET $proxy_prefix/fup?"
         ."from=$from&ID=$sid&dkey=$dkey&command=MODIFY";
   $req .= "&comment=$opt_C"    if $opt_C;
@@ -1656,14 +1655,14 @@ sub modify {
   $req .= " HTTP/1.1";
   sendheader("$server:$port",$req);
   http_response();
-  while (<$SH>) { 
+  while (<$SH>) {
     if ($opt_v) {
       print "<-- $_";
     } else {
       print if /\Q$file/;
     }
   }
-  
+
   exit;
 }
 
@@ -1672,31 +1671,31 @@ sub get_xx {
   my $transferfile = shift;
   my $ft = '';
   local $_;
-  
+
   # get transfer file from FEX server
   unless ($SH) {
     serverconnect($server,$port);
     query_sid($server,$port);
   }
-  
+
   xxget($from,$sid,$transferfile);
-  
+
   # empty file?
   unless (-s $transferfile) {
     unlink $transferfile;
     exit;
   }
-  
+
   # no further processing if delivering to pipe
   exec 'cat',$transferfile unless -t STDOUT;
-  
+
   if ($ft = `file $transferfile 2>/dev/null`) {
     if ($ft =~ /compressed/) {
       rename $transferfile,"$transferfile.gz";
       shelldo(ws("gunzip $transferfile.gz"));
     }
     $ft = `file $transferfile`;
-  } 
+  }
   # file command failed, so we look ourself into the file...
   elsif (open $transferfile,$transferfile) {
     read $transferfile,$_,4;
@@ -1723,7 +1722,11 @@ sub get_xx {
     if (/^n/i) {
       print "keeping $transferfile\n";
     } else {
-      system("tar xvf $transferfile && rm $transferfile");
+      my $untar = "tar xvf";
+      # if ($> == 0 and `tar --help 2>&1` =~ /gnu/) {
+      #  $untar = "tar --no-same-owner -xvf";
+      # }
+      system("$untar $transferfile && rm $transferfile");
       die "$0: error while untaring, see $transferfile\n" if -f $transferfile;
     }
   } else {
@@ -1734,7 +1737,7 @@ sub get_xx {
 
 
 sub formdatapost {
-  my %P = @_; 
+  my %P = @_;
   my ($boundary,$filename,$filesize,$length,$buf,$file,$fpsize,$resume,$seek);
   my ($flink);
   my (@hh,@hb,@r,@pv,$to);
@@ -1749,15 +1752,15 @@ sub formdatapost {
   local $_;
 
   if (defined($file = $P{file})) {
-    
+
     $to = $AB{$P{to}} || $P{to}; # for gpg
-    
+
     # special file: stream from STDIN
     if ($opt_s) {
       $filename = encode_utf8($file);
       $filesize = -1;
     }
-    
+
     # compression?
     if ($opt_c) {
       my ($if,$of);
@@ -1770,8 +1773,8 @@ sub formdatapost {
       $filesize = -s $transferfile;
       die "$0: cannot gzip $file\n" unless $filesize;
       $file = $transferfile;
-    } 
-    
+    }
+
     # special file: tar-on-the-fly
     if (not $windoof and $opt_a and $file =~ /(.+)\.(tar|tgz)$/) {
       $aname = $1;
@@ -1822,12 +1825,12 @@ sub formdatapost {
       $file = "$aname.$atype";
       $filename = encode_utf8($file);
       undef $SH; # force reconnect (timeout!)
-    } 
-    
+    }
+
     # single file
     else {
       $filename = encode_utf8(${'opt_='} || $file);
-    
+
       if ($windoof) {
         $filename =~ s/^[a-z]://;
         $filename =~ s/.*\\//;
@@ -1855,14 +1858,14 @@ sub formdatapost {
         }
       }
     }
-  
+
   } else {
     $file = $filename = '';
     $filesize = 0;
   }
 
   FORMDATAPOST:
-    
+
   @hh = (); # HTTP header
   @hb = (); # HTTP body
   @r = ();
@@ -1874,11 +1877,11 @@ sub formdatapost {
     serverconnect($server,$port);
     query_sid($server,$port) unless $anonymous;
   }
-  
+
   $P{id} = $sid; # ugly hack!
-  
+
   # ask server if this file has been already sent
-  if ($file and not $xx and not 
+  if ($file and not $xx and not
       ($opt_s or $opt_g or $opt_o or $opt_d or $opt_l or $opt_L or ${'opt_/'}))
   {
     ($seek,$location) = query_file($server,$port,$frecipient||$P{to},$P{from},
@@ -1897,9 +1900,9 @@ sub formdatapost {
       serverconnect($server,$port);
     }
   }
-  
+
   # file part size
-  if ($chunksize and $proxy and $port != 443 
+  if ($chunksize and $proxy and $port != 443
       and $filesize - $seek > $chunksize - $bs) {
     if ($features !~ /MULTIPOST/) {
       die sprintf("$0: server does not support chunked multi-POST needed for"
@@ -1912,7 +1915,7 @@ sub formdatapost {
   }
 
   $boundary = randstring(48);
-  
+
   $P{seek} = $seek;
   $P{filesize} = $filesize;
 
@@ -1935,7 +1938,7 @@ sub formdatapost {
       push @hb,encode_utf8($P{$v});
     }
   }
-  
+
   # at last, POST the file
   if ($file) {
     push @hb,"--$boundary";
@@ -2000,14 +2003,14 @@ sub formdatapost {
       sleep 3;
       goto FORMDATAPOST; # necessary: new $sid ==> new @hh
     };
-    
+
     unless ($opt_d or $flink) {
-      
+
       $t0 = $t2 = int(time);
       $tt = $t0-1;
       $t1 = 0;
       $tc = 0;
-      
+
       if ($opt_s) {
         if ($opt_g) {
           open $file,"gpg -e -r $to|" or die "$0: cannot run gpg - $!\n";
@@ -2052,14 +2055,21 @@ sub formdatapost {
         }
         binmode $file;
       }
-      
+
       $bytes = 0;
       autoflush $SH 0;
-      
+
       print $rcamel[0] if ${'opt_+'};
 
+      $SIG{ALRM} = sub { retry("timed out") };
       while (my $b = read $file,$buf,$bs) {
-        print {$SH} $buf or &sigpipehandler;
+        alarm($timeout*2);
+        if ($https) {
+          print {$SH} $buf or &sigpipehandler;
+        } else {
+          syswrite $SH,$buf or &sigpipehandler;
+        }
+        alarm(0);
         $bytes += $b;
         if ($filesize > 0 and $bytes+$seek > $filesize) {
           die "$0: $file filesize has grown while uploading\n";
@@ -2104,21 +2114,21 @@ sub formdatapost {
       }
       close $file; # or die "$0: error while reading $file - $!\n";
       $tt = ($t2-$t0)||1;
-      
+
       print $rcamel[2] if ${'opt_+'};
-      
+
       # terminate tar verbose output job
       if ($tpid) {
         sleep 2;
         kill 9,$tpid;
         unlink $tarlist;
       }
-    
+
       unless ($opt_q) {
         if (not $chunksize and $bytes+$seek < $filesize) {
           die "$0: $file filesize has shrunk while uploading\n";
         }
-        
+
         if ($seek or $chunksize and $chunksize < $filesize) {
           if ($fpsize>2*M) {
             printf STDERR "%s: %d MB in %d s (%d kB/s)",
@@ -2160,13 +2170,13 @@ sub formdatapost {
                           int($bytes/k/$tt);
           }
         }
-        
+
         if (-t STDOUT and not ($opt_s or $opt_g)) {
           print STDERR "waiting for server ok..."
         }
       }
     }
-    
+
     autoflush $SH 1;
     print {$SH} "\r\n--$boundary--\r\n";
 
@@ -2183,7 +2193,7 @@ sub formdatapost {
       }
       return "X-Location: $location\n";
     }
-    
+
     if ($flink) {
       $bytes = -s $flink;
       if ($bytes>2*M) {
@@ -2198,8 +2208,8 @@ sub formdatapost {
   }
 
   # SuSe: Can't locate object method "BINMODE" via package "IO::Socket::SSL::SSL_HANDLE"
-  # binmode $SH,':utf8'; 
-  
+  # binmode $SH,':utf8';
+
   if (not $opt_q and $file and -t STDOUT) {
     print STDERR "\r                         \r";
   }
@@ -2209,7 +2219,7 @@ sub formdatapost {
     last if @r and $r[0] =~ / 204 / and /^$/ or /<\/html>/i;
     push @r,decode_utf8($_);
   }
-  
+
   if ($file) {
     close $SH;
     undef $SH;
@@ -2217,7 +2227,7 @@ sub formdatapost {
       goto FORMDATAPOST;
     }
   }
-  
+
   return @r;
 }
 
@@ -2295,7 +2305,7 @@ sub zip {
   }
   print $cmd,"\n" if $opt_v;
   open $cmd,"|$cmd" or die "$0: cannot create $zip - $!\n";
-  foreach (@_) { 
+  foreach (@_) {
     print {$cmd} $_."\n";
     print "  $_\n" if $opt_v;
   }
@@ -2308,7 +2318,7 @@ sub zip {
 sub getline {
   my $file = shift;
   local $_;
-  
+
   while (<$file>) {
     chomp;
     s/^#.*//;
@@ -2328,7 +2338,7 @@ sub query_file {
   my ($head,$location);
   my ($response,$fexsrv);
   local $_;
-  
+
   $to =~ s/,.*//;
   $to =~ s/:\w+=.*//;
   $to = $AB{$to} if $AB{$to};
@@ -2371,7 +2381,7 @@ sub query_file {
 
   # return true seek only if file is identified
   $seek = 0 if $qfileid and $qfileid ne $fileid;
-  
+
   return ($seek,$location);
 }
 
@@ -2382,7 +2392,7 @@ sub edit_address_book {
   my $ab = "$fexhome/ADDRESS_BOOK";
   my (%AB,@r);
   local $_;
-  
+
   die "$0: address book not available for subusers\n"      if $skey;
   die "$0: address book not available for group members\n" if $gkey;
 
@@ -2390,7 +2400,7 @@ sub edit_address_book {
 
   %AB = query_address_book($server,$port,$user);
   if ($AB{ADDRESS_BOOK} !~ /\w/) {
-    $AB{ADDRESS_BOOK} = 
+    $AB{ADDRESS_BOOK} =
       "# Format: alias e-mail-address # Comment\n".
       "# Example:\n".
       "framstag framstag\@rus.uni-stuttgart.de\n";
@@ -2398,22 +2408,22 @@ sub edit_address_book {
   open $ab,">$ab" or die "$0: cannot write to $ab - $!\n";
   print {$ab} $AB{ADDRESS_BOOK};
   close $ab;
-  
+
   system $editor,$ab;
   exit unless -s $ab;
 
   $opt_o = $opt_A;
-  
+
   serverconnect($server,$port);
   query_sid($server,$port);
-  
+
   @r = formdatapost(
        from            => $user,
         to             => $user,
         id             => $sid,
         file           => $ab,
   );
-  
+
   unlink $ab,$ab.'~';
 }
 
@@ -2428,7 +2438,7 @@ sub query_address_book {
     serverconnect($server,$port);
     query_sid($server,$port);
   }
-  
+
   $req = "GET $proxy_prefix/fop/$user/$user/ADDRESS_BOOK?ID=$sid HTTP/1.1";
   sendheader("$server:$port",$req);
   $_ = <$SH>;
@@ -2455,7 +2465,7 @@ sub query_address_book {
     last if /^$/;
     $cl = $1 if /^Content-Length: (\d+)/;
   }
-  
+
   if ($cl) {
     while (<$SH>) {
       $b += length;
@@ -2485,9 +2495,9 @@ sub query_address_book {
       last if $b >= $cl;
     }
   }
-  
+
   $AB{ADDRESS_BOOK} = $ab;
-  
+
   return %AB;
 }
 
@@ -2518,7 +2528,7 @@ sub query_sid {
   }
   s/\r//;
   print "<-- $_" if $opt_v;
-    
+
   if (/^HTTP.* [25]0[01] /) {
     if (not $proxy and $port ne 443 and /^HTTP.* 201 (.+)/) {
       $sid = 'MD5H:'.md5_hex($id.$1);
@@ -2545,13 +2555,13 @@ sub query_sid {
     serverconnect($server,$port);
     $sid = $id;
   }
-  
+
   # warn "proxy: $proxy\n";
   if ($proxy) {
     serverconnect($server,$port);
     $sid = $id;
   }
-  
+
 }
 
 
@@ -2577,13 +2587,13 @@ sub xxget {
   }
 
   die "$0: no Content-Length in server-reply\n" unless $cl;
-  
+
   open F,">$save" or die "$0: cannot write to $save - $!\n";
   binmode F;
-  
+
   $t0 = $t1 = int(time);
   $tso = '';
-  
+
   while ($b = read($SH,$_,$bs)) {
     $B += $b;
     print F;
@@ -2597,7 +2607,7 @@ sub xxget {
     }
     sleep 1 while ($opt_m and $B/k/(time-$t0||1) > $opt_m);
   }
-  
+
   print STDERR ts($B,$cl),"\n";
   close F;
 }
@@ -2608,24 +2618,30 @@ sub ts {
   my ($b,$tb) = @_;
   return sprintf("transferred: %d MB (%d%%)",int($b/M),int($b/$tb*100));
 }
-  
+
 
 sub sigpipehandler {
-  $SIG{ALRM} = sub { };
+  retry("died");
+}
+
+sub retry {
+  my $reason = shift;
+  local $SIG{ALRM} = sub { };
+
   if (fileno $SH) {
     alarm(1);
-    @_ = <$SH>;
+    my @r = <$SH>;
     alarm(0);
     kill 9,$tpid if $tpid;
-    if (@_ and $opt_v) {
-      die "\n$0: ($$) server error: @_\n";
+    if (@r and $opt_v) {
+      die "\n$0: ($$) server error: @r\n";
     }
-    if (@_ and $_[0] =~ /^HTTP.* \d+ (.*)/) {
+    if (@r and $r[0] =~ /^HTTP.* \d+ (.*)/) {
       die "\n$0: server error: $1\n";
     }
   }
   $timeout *= 2;
-  warn "\n$0: connection to $server died\n";
+  warn "\n$0: connection to $server $reason\n";
   warn "retrying after $timeout seconds...\n";
   sleep $timeout;
   if ($windoof) { exec $^X,$0,@_ARGV }
@@ -2638,7 +2654,7 @@ sub checkrecipient {
   my ($from,$to) = @_;
   my @r;
   local $_;
-  
+
   @r = formdatapost(
        from    => $from,
         to     => $to,
@@ -2720,11 +2736,11 @@ sub readahead {
   my $s = 0;
   my $n;
   local $_;
-  
-  while ($s < $ba) { 
+
+  while ($s < $ba) {
     $n = $ba-$s;
-    $n = $bs if $n > $bs; 
-    $s += read $fh,$_,$n; 
+    $n = $bs if $n > $bs;
+    $s += read $fh,$_,$n;
   }
 }
 
@@ -2736,12 +2752,43 @@ sub fileid {
 }
 
 
+sub get_mutt_alias {
+  my $to = shift;
+  my $ma = $HOME.'/.mutt/aliases';
+  my $alias;
+  local $_;
+
+  open $ma,$ma or return $to;
+  while (<$ma>) {
+    if (/^alias \Q$to\E\s/i) {
+      chomp;
+      s/\s*#.*//;
+      s/\(.*?\)//;
+      s/\s+$//;
+      s/.*\s+//;
+      s/[<>]//g;
+      if (/,/) {
+        warn "$0: ignoring mutt multi-alias $to = $alias\n";
+        last;
+      }
+      if (/@/) {
+        $alias = $_;
+        warn "$0: found mutt alias $to = $alias\n";
+        last;
+      }
+    }
+  }
+  close $ma;
+  return ($alias||$to);
+}
+
+
 # collect file meta data (filename, inode, mtime)
 sub fmd {
   my @files = @_;
   my ($file,$dir);
   my $fmd = '';
-  
+
   foreach $file (@files) {
     if (not -l $file and -d $file) {
       $dir = $file;
@@ -2760,7 +2807,7 @@ sub fmd {
       $fmd .= $file.fileid($file);
     }
   }
-  
+
   return $fmd;
 }
 
@@ -2770,7 +2817,7 @@ sub decode_b64 {
   local $_ = shift;
   my $uu = '';
   my ($i,$l);
-  
+
   tr|A-Za-z0-9+=/||cd;
   s/=+$//;
   tr|A-Za-z0-9+/| -_|;
@@ -2815,6 +2862,7 @@ sub http_response {
   unless (defined $_ and /\w/) {
     die "$0: no response from server\n";
   }
+  print "<-- $_\n" if $opt_v;
   s/\r?\n//;
   # CGI fatalsToBrowser
   if (/^HTTP.* 500/) {
@@ -2825,9 +2873,12 @@ sub http_response {
   unless (/^HTTP.* 200/) {
     $error = $_;
     $error =~ s/HTTP.[\s\d.]+//;
-    if ($opt_v) {
-      print "<-- $_";
-      print "<-- $_" while <$SH>;
+    @r = <$SH> unless @r;
+    @r = ()    unless @r;
+    foreach (@r) {
+      chomp;
+      $error .= "\n".$_ if /^Location/;
+      print "<-- $_\n" if $opt_v;
     }
     die "$0: server error: $error\n";
   }
@@ -2846,15 +2897,15 @@ sub ws {
 sub update {
   my $cfb = '### common functions ###';
   my $cfc;
-  
+
   local $/;
-  
+
   open $0,$0 or die "cannot read $0 - $!\n";
   $_ = <$0>;
   close $0;
   s/.*\n$cfb\n//s;
   $cfc = $_;
-  
+
   foreach my $p (qw(fexget sexsend)) {
     open $p,$p or die "cannot read $p - $!\n";
     $_ = <$p>;
@@ -2891,9 +2942,9 @@ sub get_ssl_env {
   $SSL{SSL_verify_mode} = $ENV{SSLVERIFY} if defined($ENV{SSLVERIFY});
   foreach my $opt (qw(
     SSL_version
-    SSL_cipher_list 
-    SSL_verify_mode 
-    SSL_ca_path 
+    SSL_cipher_list
+    SSL_verify_mode
+    SSL_ca_path
     SSL_ca_file)
   ) {
     my $env = uc($opt);
@@ -2936,16 +2987,10 @@ sub serverconnect {
   my ($server,$port) = @_;
   my $connect = "CONNECT $server:$port HTTP/1.1";
   local $_;
-  
-  if ($opt_v and $port == 443 and %SSL) {
-    foreach my $v (keys %SSL) {
-      printf "%s => %s\n",$v,$SSL{$v};
-    }
-  }
-  
+
   if ($proxy) {
     tcpconnect(split(':',$proxy));
-    if ($port == 443) {
+    if ($https) {
       printf "--> %s\n",$connect if $opt_v;
       nvtsend($connect,"");
       $_ = <$SH>;
@@ -2954,14 +2999,13 @@ sub serverconnect {
       unless (/^HTTP.1.. 200/) {
         die "$0: proxy error : $_";
       }
-      eval "use IO::Socket::SSL";
-      die "$0: cannot load IO::Socket::SSL\n" if $@;
+      &enable_ssl;
       $SH = IO::Socket::SSL->start_SSL($SH,%SSL);
     }
   } else {
     tcpconnect($server,$port);
   }
-#  if ($port == 443 and $opt_v) {
+#  if ($https and $opt_v) {
 #    printf "%s\n",$SH->get_cipher();
 #  }
 }
@@ -2970,16 +3014,15 @@ sub serverconnect {
 # set up tcp/ip connection
 sub tcpconnect {
   my ($server,$port) = @_;
-  
+
   if ($SH) {
     close $SH;
     undef $SH;
   }
-  
-  if ($port == 443) {
+
+  if ($https) {
     # eval "use IO::Socket::SSL qw(debug3)";
-    eval "use IO::Socket::SSL";
-    die "$0: cannot load IO::Socket::SSL\n" if $@;
+    &enable_ssl;
     $SH = IO::Socket::SSL->new(
       PeerAddr => $server,
       PeerPort => $port,
@@ -2993,24 +3036,36 @@ sub tcpconnect {
       Proto    => 'tcp',
     );
   }
-  
+
   if ($SH) {
     autoflush $SH 1;
   } else {
     die "$0: cannot connect $server:$port - $@\n";
   }
-  
+
   print "TCPCONNECT to $server:$port\n" if $opt_v;
 }
 
 
+sub enable_ssl {
+  eval "use IO::Socket::SSL";
+  die "$0: cannot load IO::Socket::SSL\n" if $@;
+  eval '$SSL{SSL_verify_mode} = 0 if Net::SSLeay::SSLeay() <= 9470143';
+  if ($opt_v) {
+    foreach my $v (keys %SSL) {
+      printf "%s => %s\n",$v,$SSL{$v};
+    }
+  }
+}
+
+
 sub sendheader {
   my $sp = shift;
   my @head = @_;
   my $head;
-  
+
   push @head,"Host: $sp";
-  
+
   foreach $head (@head) {
     print "--> $head\n" if $opt_v;
     print {$SH} $head,"\r\n";
@@ -3022,12 +3077,12 @@ sub sendheader {
 
 sub nvtsend {
   local $SIG{PIPE} = sub { $sigpipe = "@_" };
-  
+
   $sigpipe = '';
-  
+
   die "$0: internal error: no active network handle\n" unless $SH;
   die "$0: remote host has closed the link\n" unless $SH->connected;
-  
+
   foreach my $line (@_) {
     print {$SH} $line,"\r\n";
     if ($sigpipe) {
@@ -3035,7 +3090,7 @@ sub nvtsend {
       return 0;
     }
   }
-  
+
   return 1;
 }
 
@@ -3045,7 +3100,7 @@ sub encode_b64 {
   my $res = "";
   my $eol = "\n";
   my $padding;
-  
+
   pos($_[0]) = 0;
   $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
   $res =~ tr|` -_|AA-Za-z0-9+/|;