Original release 20160328

[fex.git] / bin / fexget

diff --git a/bin/fexget b/bin/fexget
index 034ced112fa3d6e581ea7a092c602f9c6e2ff436..b0616a16fe5653e4d7830bb24116f34b6d2e30c6 100755 (executable)
--- a/bin/fexget
+++ b/bin/fexget
@@ -30,9 +30,11 @@ our $SH;
 our ($fexhome,$idf,$tmpdir,$windoof,$useragent);
 our ($xv,%autoview);
 our $bs = 2**16; # blocksize for tcp-reading and writing file
 our ($fexhome,$idf,$tmpdir,$windoof,$useragent);
 our ($xv,%autoview);
 our $bs = 2**16; # blocksize for tcp-reading and writing file

-our $version = 20150120;
+our $version = 20160328;

 our $CTYPE = 'ISO-8859-1';
 our $fexsend = $ENV{FEXSEND} || 'fexsend';
 our $CTYPE = 'ISO-8859-1';
 our $fexsend = $ENV{FEXSEND} || 'fexsend';

+our $DEBUG = $ENV{DEBUG};
+our $_0 = $0;

 
 my %SSL = (SSL_version => 'TLSv1');
 my $sigpipe;
 
 my %SSL = (SSL_version => 'TLSv1');
 my $sigpipe;


@@ -57,6 +59,14 @@ if ($Config{osname} =~ /^mswin/i) {
   $SSL{SSL_verify_mode} = 0;
   chdir $ENV{USERPROFILE}.'\Desktop';
   # open XX,'>XXXXXX';close XX;
   $SSL{SSL_verify_mode} = 0;
   chdir $ENV{USERPROFILE}.'\Desktop';
   # open XX,'>XXXXXX';close XX;

+} elsif ($Config{osname} =~ /^darwin/i or $ENV{MACOS}) {
+  $0 =~ s:(.*)/:: and $ENV{PATH} .= ":$1";
+  $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex';
+  $tmpdir = $ENV{FEXTMP} || $ENV{TMPDIR} || "$fexhome/tmp";
+  $idf = "$fexhome/id";
+  $_ = `sw_vers -productVersion 2>/dev/null`||'';
+  chomp;
+  $useragent = "fexget-$version (MacOS $_)";

 } else {
   $0 =~ s:(.*)/:: and $ENV{PATH} .= ":$1";
   $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex';
 } else {
   $0 =~ s:(.*)/:: and $ENV{PATH} .= ":$1";
   $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex';


@@ -115,7 +125,7 @@ SSLCIPHERLIST=HIGH:!3DES    # see http://www.openssl.org/docs/apps/ciphers.html
 
 You can set these environment variables also in $HOME/.fex/config.pl, as well as
 the $opt_* variables, e.g.:
 
 You can set these environment variables also in $HOME/.fex/config.pl, as well as
 the $opt_* variables, e.g.:

-  
+

 $ENV{SSLVERSION} = 'TLSv1';
 ${'opt_+'} = 1;
 $opt_m = 200;
 $ENV{SSLVERSION} = 'TLSv1';
 ${'opt_+'} = 1;
 $opt_m = 200;


@@ -141,7 +151,7 @@ $opt_V = $opt_X = $opt_f = $opt_L = $opt_H = 0;
 ${'opt_+'} = 0;
 $opt_s = $opt_k = $opt_i = $opt_P = '';
 $_ = "$fexhome/config.pl"; require if -f;
 ${'opt_+'} = 0;
 $opt_s = $opt_k = $opt_i = $opt_P = '';
 $_ = "$fexhome/config.pl"; require if -f;

-getopts('hvVHlLdkzoaXf+m:s:i:K:P:') or die $usage;
+getopts('hvVHlLdkzoaXVf+m:s:i:K:P:') or die $usage;

 $opt_k = '?KEEP' if $opt_k;
 
 if ($opt_m =~ /(\d+)/) {
 $opt_k = '?KEEP' if $opt_k;
 
 if ($opt_m =~ /(\d+)/) {


@@ -150,69 +160,47 @@ if ($opt_m =~ /(\d+)/) {
   $opt_m = 0
 }
 
   $opt_m = 0
 }
 

-print "Version: $version\n" if $opt_V;
+if ($opt_V) {
+  print "Version: $version\n";
+  unless (@ARGV) {
+    print "Upgrade fexget? ";
+    $_ = <STDIN>||'';
+    if (/^y/i) {
+      my $new = `wget -nv -O- http://fex.belwue.de/download/fexget`;
+      if ($new !~ /upgrade fexget/) {
+        die "$0: bad update\n";
+      }
+      system qw'cp -a',$_0,$_0.'_old';
+      exit $? if $?;
+      open $_0,'>',$_0 or die "$0: cannot write $_0. - $!\n";
+      print {$_0} $new;
+      close $_0;
+      exec $_0,qw'-V .';
+    }
+  }
+  exit if "@ARGV" eq '.';
+}
+

 die $usage                  if $opt_h;
 if ($opt_H) {
   print $hints;
   exit;
 }
 
 die $usage                  if $opt_h;
 if ($opt_H) {
   print $hints;
   exit;
 }
 

-# set SSL/TLS options
-$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_ca_file)
-) {
-  my $env = uc($opt);
-  $env =~ s/_//g;
-  $SSL{$opt} = $ENV{$env} if defined($ENV{$env});
-}
-
-if ($SSL{SSL_verify_mode}) {
-  &search_ca;
-  unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) {
-    die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n";
-  }
-} elsif (defined($SSL{SSL_verify_mode})) {
-  # user has set SSLVERIFY=0 !
-} else {
-  &search_ca;
-  $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file};
-}
-
-sub search_ca {
-  local $_;
-  return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path};
-  foreach (qw(/etc/ssl/certs/ca-certificates.crt)) {
-    if (-f) {
-      $SSL{SSL_ca_file} = $_;
-      return;
-    }
-  }
-  foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) {
-    if (-f) {
-      $SSL{SSL_ca_path} = $_;
-      return;
-    }
-  }
-}
+&get_ssl_env;

 
 my $ffl = "$tmpdir/fexget";            # F*EX files list (cache)
 
 my @rcamel = (
 '\e[A
 
 my $ffl = "$tmpdir/fexget";            # F*EX files list (cache)
 
 my @rcamel = (
 '\e[A

-(_*)  _  _     
-   \\\\/ \\/ \\
+ (_*p _  _
+   \\\\/ \/ \\

     \  __  )=*
     \  __  )=*

-    //\\\\//\\\\   
+    //\\\\//\\\\

 ',
 ',

-'\e[A     \\\\/\\\\/ 
-',
-'\e[A    //\\\\//\\\\
-');
+"\e[A     \\\\/\\\\/ \n",
+"\e[A    //\\\\//\\\\\n"
+);

 
 # get fexlog
 if ($opt_z) {
 
 # get fexlog
 if ($opt_z) {


@@ -274,7 +262,7 @@ if ($opt_a) {
   }
 }
 
   }
 }
 

-my ($file,%files,$download,$server,$port,$fop);
+my ($file,%files,$download,$server,$port,$fop,$https);

 
 if ($opt_f) {
   unless ($ENV{FEXID} or -f $ENV{HOME}.'/.fex/id') {
 
 if ($opt_f) {
   unless ($ENV{FEXID} or -f $ENV{HOME}.'/.fex/id') {


@@ -312,6 +300,7 @@ URL: foreach my $url (@ARGV) {
   }
 
   if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/.*fop/\S+)}) {
   }
 
   if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/.*fop/\S+)}) {

+    $https  = $1;

     $server = $2;
     $port   = $4 || ($1?443:80);
     $fop    = $5;
     $server = $2;
     $port   = $4 || ($1?443:80);
     $fop    = $5;


@@ -365,7 +354,7 @@ URL: foreach my $url (@ARGV) {
   exit if $opt_s eq '-';
   unlink $download unless -s $download;
   exit 2 unless -f $download;
   exit if $opt_s eq '-';
   unlink $download unless -s $download;
   exit 2 unless -f $download;

-  
+

   if ($windoof) {
     print "READY\n";
     exit;
   if ($windoof) {
     print "READY\n";
     exit;


@@ -387,7 +376,7 @@ URL: foreach my $url (@ARGV) {
   }
 
   unless ($opt_X) {
   }
 
   unless ($opt_X) {

-    
+

     foreach my $a (keys %autoview) {
       if ($download =~ /$a$/i and $autoview{$a}) {
         printf "run \"%s %s\" [Yn] ? ",$autoview{$a},basename($download);
     foreach my $a (keys %autoview) {
       if ($download =~ /$a$/i and $autoview{$a}) {
         printf "run \"%s %s\" [Yn] ? ",$autoview{$a},basename($download);


@@ -396,9 +385,10 @@ URL: foreach my $url (@ARGV) {
         next URL;
       }
     }
         next URL;
       }
     }

-    
+

     if ($ENV{DISPLAY} and $download =~ /\.(gif|jpg|png|tiff?)$/i) {
       # see also mimeopen and xdg-mime
     if ($ENV{DISPLAY} and $download =~ /\.(gif|jpg|png|tiff?)$/i) {
       # see also mimeopen and xdg-mime

+      # http://unix.stackexchange.com/questions/144047/how-does-xdg-open-do-its-work

       if (my $xv = $xv || pathsearch('xv') || pathsearch('xdg-open')) {
         printf "run \"%s %s\" [Yn] ? ",basename($xv),basename($download);
         $_ = <STDIN>||'';
       if (my $xv = $xv || pathsearch('xv') || pathsearch('xdg-open')) {
         printf "run \"%s %s\" [Yn] ? ",basename($xv),basename($download);
         $_ = <STDIN>||'';


@@ -406,12 +396,12 @@ URL: foreach my $url (@ARGV) {
         next URL;
       }
     }
         next URL;
       }
     }

-  
+

     if ($download =~ /$atype/) {
     if ($download =~ /$atype/) {

-      if    ($download =~ /\.(tgz|tar.gz)$/)  { extract('tar tvzf','tar xvzf') }
-      elsif ($download =~ /\.tar$/)           { extract('tar tvf','tar xvf') } 
-      elsif ($download =~ /\.zip$/i)          { extract('unzip -l','unzip') } 
-      elsif ($download =~ /\.7z$/i)           { extract('7z l','7z x') }
+      if    ($download =~ /\.(tgz|tar.gz)$/) { extract('tar tvzf','tar xvzf') }
+      elsif ($download =~ /\.tar$/)          { extract('tar tvf','tar xvf') }
+      elsif ($download =~ /\.zip$/i)         { extract('unzip -l','unzip') }
+      elsif ($download =~ /\.7z$/i)          { extract('7z l','7z x') }

       else { die "$0: unknown archive \"$download\"\n" }
       if ($? == 0) {
         unlink $download;
       else { die "$0: unknown archive \"$download\"\n" }
       if ($? == 0) {
         unlink $download;


@@ -429,21 +419,22 @@ sub extract {
   my $l = shift;
   my $x = shift;
   my $d = $download;
   my $l = shift;
   my $x = shift;
   my $d = $download;

-  my $xd = '.';
+  my $xd = '';

   local $_;
   local $_;

-  
+

   if (-t and not $windoof) {
     print "Files in archive:\n";
     system(split(' ',$l),$download);
     $d =~ s:.*/:./:;
     $d =~ s/\.[^.]+$//;
   if (-t and not $windoof) {
     print "Files in archive:\n";
     system(split(' ',$l),$download);
     $d =~ s:.*/:./:;
     $d =~ s/\.[^.]+$//;

+    $d =~ s:/*$:/:;

     for (;;) {
       $xd = inquire("extract to directory (Ctrl-C to keep archive): ",$d);
     for (;;) {
       $xd = inquire("extract to directory (Ctrl-C to keep archive): ",$d);

-      last if $xd =~ s:^(\./*)*!?$:./:;
+      last if $xd =~ s:^(\./*)*!?$::;

       if ($xd eq '-') {
         print "keeping $download\n";
         exit;
       if ($xd eq '-') {
         print "keeping $download\n";
         exit;

-      }    
+      }

       if ($xd !~ s/!$//) {
         if (-d $xd) {
           print "directory $xd does already exist, add \"!\" to overwrite\n";
       if ($xd !~ s/!$//) {
         if (-d $xd) {
           print "directory $xd does already exist, add \"!\" to overwrite\n";


@@ -461,8 +452,9 @@ sub extract {
       last;
     }
   }
       last;
     }
   }

-  print "extracting to $xd :\n";
+  print "extracting to $xd :\n" if $xd;

   system(split(' ',$x),$download);
   system(split(' ',$x),$download);

+  print "extracted to $xd\n" if $xd;

 }
 
 sub del {
 }
 
 sub del {


@@ -494,7 +486,7 @@ sub del {
 sub forward {
   my $url = shift;
   my ($server,$port);
 sub forward {
   my $url = shift;
   my ($server,$port);

-  my ($uri,$dkey,$list,$cmd,$n);
+  my ($uri,$dkey,$list,$cmd,$n,$copy);

   my @r;
 
   if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/fop/.+)}) {
   my @r;
 
   if ($url =~ m{^http(s?)://([\w\.\-]+)(:(\d+))?(/fop/.+)}) {


@@ -510,16 +502,22 @@ sub forward {
     "GET $uri?COPY HTTP/1.1",
     "User-Agent: $useragent",
   );
     "GET $uri?COPY HTTP/1.1",
     "User-Agent: $useragent",
   );

-  
+

   $_ = <$SH>;
   die "$0: no reply from fex server $server\n" unless $_;
   warn "<-- $_" if $opt_v;
   $_ = <$SH>;
   die "$0: no reply from fex server $server\n" unless $_;
   warn "<-- $_" if $opt_v;

-  
-  unless (/^HTTP.*200/) {
+
+  if (/^HTTP.*already exists/) {
+    if ($uri =~ m:/fop/(\w+)/:) {
+      $dkey = $1;
+    }
+  } elsif (/^HTTP.*200/) {
+    # ok!
+  } else {

     s/^HTTP.... \d+ //;
     die "$0: $_";
   }
     s/^HTTP.... \d+ //;
     die "$0: $_";
   }

-  
+

   while (<$SH>) {
     s/\r//;
     last if /^\n/; # ignore HTML output
   while (<$SH>) {
     s/\r//;
     last if /^\n/; # ignore HTML output


@@ -527,8 +525,7 @@ sub forward {
     warn "<-- $_" if $opt_v;
   }
 
     warn "<-- $_" if $opt_v;
   }
 

-  $cmd = 'fexsend -l >/dev/null 2>&1';
-  print "$cmd\n" if $opt_v;
+  print "fexsend -l\n" if $opt_v;

   system 'fexsend -l >/dev/null 2>&1';
   $list = $ENV{HOME}.'/.fex/tmp/fexlist';
   open $list,$list or die "$0: cannot open $list - $!\n";
   system 'fexsend -l >/dev/null 2>&1';
   $list = $ENV{HOME}.'/.fex/tmp/fexlist';
   open $list,$list or die "$0: cannot open $list - $!\n";


@@ -542,7 +539,7 @@ sub forward {
     }
   }
   close $list;
     }
   }
   close $list;

-  
+

   if ($n) {
     $cmd = "fexsend -d $n >/dev/null 2>&1";
     print "$cmd\n" if $opt_v;
   if ($n) {
     $cmd = "fexsend -d $n >/dev/null 2>&1";
     print "$cmd\n" if $opt_v;


@@ -589,7 +586,7 @@ sub keep {
 
 sub download {
   my ($server,$port,$fop,$nocheck) = @_;
 
 sub download {
   my ($server,$port,$fop,$nocheck) = @_;

-  my ($file,$download,$ssl,$pipe,$filesize,$checkstorage);
+  my ($file,$download,$ssl,$pipe,$filesize,$checkstorage,$dkey);

   my (@hh,@r);
   my ($t0,$t1,$t2,$tt,$tm,$ts,$kBs,$b,$bt,$tb,$B,$buf);
   my $length = 0;
   my (@hh,@r);
   my ($t0,$t1,$t2,$tt,$tm,$ts,$kBs,$b,$bt,$tb,$B,$buf);
   my $length = 0;


@@ -604,14 +601,18 @@ sub download {
       $pipe = $download = $opt_s;
     } elsif (-p $opt_s or -c $opt_s) {
       $download = $opt_s;
       $pipe = $download = $opt_s;
     } elsif (-p $opt_s or -c $opt_s) {
       $download = $opt_s;

+      $nocheck = 'pipe or character device';

     } else {
       $download = $file.'.tmp';
       $seek = -s $download || 0;
     }
   } else {
     # ask server for real file name
     } else {
       $download = $file.'.tmp';
       $seek = -s $download || 0;
     }
   } else {
     # ask server for real file name

-    serverconnect($server, $port);
-    sendheader("$server:$port","HEAD $proxy_prefix$fop HTTP/1.1","User-Agent: $useragent");
+    sendheader(
+      "$server:$port",
+      "HEAD $proxy_prefix$fop HTTP/1.1",
+      "User-Agent: $useragent"
+    );

     my $reply = $_ = <$SH>;
     unless (defined $_ and /\w/) {
       die "$0: no response from server\n";
     my $reply = $_ = <$SH>;
     unless (defined $_ and /\w/) {
       die "$0: no response from server\n";


@@ -638,8 +639,11 @@ sub download {
     $seek = -s $download || 0;
   }
 
     $seek = -s $download || 0;
   }
 

+  $fop =~ m:/fop/(\w+)/: and $dkey=$1 or $dkey='';
+

   push @hh,"GET $proxy_prefix$fop$opt_k HTTP/1.1",
            "User-Agent: $useragent",
   push @hh,"GET $proxy_prefix$fop$opt_k HTTP/1.1",
            "User-Agent: $useragent",

+           "Cookie: dkey=$dkey",

            "Connection: close";
   push @hh,"Range: bytes=$seek-" if $seek;
 
            "Connection: close";
   push @hh,"Range: bytes=$seek-" if $seek;
 


@@ -685,28 +689,34 @@ sub download {
       }
     }
     if ($checkstorage and not $nocheck) {
       }
     }
     if ($checkstorage and not $nocheck) {

-      $t0 = time;
+      my $t0 = my $t1 = my $t2 = time;

       my $n = 0;
       my $n = 0;

+      my $buf = '.' x M;
+      my $storagetest = $file.'.test';
+      my $error = "$0: cannot write \"$storagetest\"";
+      open $storagetest,'>',$storagetest or die "$error - $!\n";

       print STDERR "checking storage...\r";
       print STDERR "checking storage...\r";

-      $buf = '.' x M;
-      while (-s $download < $checkstorage) {
-        syswrite X,$buf or do {
-          unlink $download;
-          die "\n$0: cannot write $download - $!\n";
+      while (-s $storagetest < $checkstorage) {
+        syswrite $storagetest,$buf or do {
+          unlink $storagetest;
+          die "\n$error - $!\n";

         };
         $n++;
         };
         $n++;

-        print STDERR "checking storage... ".$n." MB\r";
+        $t2 = int(time);
+        if ($t2 > $t1) {
+          print STDERR "checking storage... ".$n." MB\r";
+          $t1 = $t2;
+        }

       }
       }

-      close X or do {
-        unlink $download;
-        die "\n$0: cannot write $download - $!\n";
+      close $storagetest or do {
+        unlink $storagetest;
+        die "\n$error - $!\n";

       };
       print STDERR "checking storage... ".$n." MB ok!\n";
       };
       print STDERR "checking storage... ".$n." MB ok!\n";

-      unlink $download;
-      if (time-$t0 < 25) {
-        open X,'>',$download or die "$0: cannot write to \"$download\" - $!\n";
-      } else {
+      unlink $storagetest;
+      if (time-$t0 > 25) {

         # retry after timeout
         # retry after timeout

+        serverconnect($server,$port);

         return(download($server,$port,$fop,'nocheck'))
       }
     }
         return(download($server,$port,$fop,'nocheck'))
       }
     }


@@ -762,7 +772,7 @@ sub download {
   }
   close $SH;
   close X;
   }
   close $SH;
   close X;

-  
+

   print $rcamel[2] if ${'opt_+'};
 
   $tt = $t2-$t0;
   print $rcamel[2] if ${'opt_+'};
 
   $tt = $t2-$t0;


@@ -840,20 +850,13 @@ sub locale {
 
 sub pathsearch {
   my $prg = shift;
 
 sub pathsearch {
   my $prg = shift;

-  
+

   foreach my $dir (split(':',$ENV{PATH})) {
     return "$dir/$prg" if -x "$dir/$prg";
   }
 }
 
   foreach my $dir (split(':',$ENV{PATH})) {
     return "$dir/$prg" if -x "$dir/$prg";
   }
 }
 

-    
-sub quote {
-  local $_ = shift;
-  s/([^\w¡-ÿ_%\/=~:.,-])/\\$1/g;
-  return $_;
-}

 
 

-    

 {
   my $tty;
 
 {
   my $tty;
 


@@ -871,10 +874,11 @@ sub quote {
 
       if (defined(&TIOCSTI) and $tty and open($tty,'>',$tty)) {
         print $prompt;
 
       if (defined(&TIOCSTI) and $tty and open($tty,'>',$tty)) {
         print $prompt;

-        foreach my $a (split("",$default)) { ioctl($tty,&TIOCSTI,$a) } 
+        # push default answer into keyboard buffer
+        foreach my $a (split("",$default)) { ioctl($tty,&TIOCSTI,$a) }

         chomp($_ = <STDIN>||'');
       } else {
         chomp($_ = <STDIN>||'');
       } else {

-        $prompt =~ s/([\?:=]\s*)/ [$default]$1/ or $prompt .= " [$default]";
+        $prompt =~ s/([\?:=]\s*)/ [$default]$1/ or $prompt .= " [$default] ";

         print $prompt;
         chomp($_ = <STDIN>||'');
         $_ = $default unless length;
         print $prompt;
         chomp($_ = <STDIN>||'');
         $_ = $default unless length;


@@ -885,8 +889,8 @@ sub quote {
     }
 
     return $_;
     }
 
     return $_;

-  }    
-}    
+  }
+}

 
 
 ### common functions ###
 
 
 ### common functions ###


@@ -910,9 +914,9 @@ sub get_ssl_env {
   $SSL{SSL_verify_mode} = $ENV{SSLVERIFY} if defined($ENV{SSLVERIFY});
   foreach my $opt (qw(
     SSL_version
   $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);
     SSL_ca_file)
   ) {
     my $env = uc($opt);


@@ -955,16 +959,10 @@ sub serverconnect {
   my ($server,$port) = @_;
   my $connect = "CONNECT $server:$port HTTP/1.1";
   local $_;
   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 ($proxy) {
     tcpconnect(split(':',$proxy));

-    if ($port == 443) {
+    if ($https) {

       printf "--> %s\n",$connect if $opt_v;
       nvtsend($connect,"");
       $_ = <$SH>;
       printf "--> %s\n",$connect if $opt_v;
       nvtsend($connect,"");
       $_ = <$SH>;


@@ -973,14 +971,13 @@ sub serverconnect {
       unless (/^HTTP.1.. 200/) {
         die "$0: proxy error : $_";
       }
       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);
   }
       $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();
 #  }
 }
 #    printf "%s\n",$SH->get_cipher();
 #  }
 }


@@ -989,16 +986,15 @@ sub serverconnect {
 # set up tcp/ip connection
 sub tcpconnect {
   my ($server,$port) = @_;
 # set up tcp/ip connection
 sub tcpconnect {
   my ($server,$port) = @_;

-  
+

   if ($SH) {
     close $SH;
     undef $SH;
   }
   if ($SH) {
     close $SH;
     undef $SH;
   }

-  
-  if ($port == 443) {
+
+  if ($https) {

     # eval "use IO::Socket::SSL qw(debug3)";
     # 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,
     $SH = IO::Socket::SSL->new(
       PeerAddr => $server,
       PeerPort => $port,


@@ -1012,24 +1008,37 @@ sub tcpconnect {
       Proto    => 'tcp',
     );
   }
       Proto    => 'tcp',
     );
   }

-  
+

   if ($SH) {
     autoflush $SH 1;
   if ($SH) {
     autoflush $SH 1;

+    binmode $SH;

   } else {
     die "$0: cannot connect $server:$port - $@\n";
   }
   } else {
     die "$0: cannot connect $server:$port - $@\n";
   }

-  
+

   print "TCPCONNECT to $server:$port\n" if $opt_v;
 }
 
 
   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;
 sub sendheader {
   my $sp = shift;
   my @head = @_;
   my $head;

-  
+

   push @head,"Host: $sp";
   push @head,"Host: $sp";

-  
+

   foreach $head (@head) {
     print "--> $head\n" if $opt_v;
     print {$SH} $head,"\r\n";
   foreach $head (@head) {
     print "--> $head\n" if $opt_v;
     print {$SH} $head,"\r\n";


@@ -1041,12 +1050,12 @@ sub sendheader {
 
 sub nvtsend {
   local $SIG{PIPE} = sub { $sigpipe = "@_" };
 
 sub nvtsend {
   local $SIG{PIPE} = sub { $sigpipe = "@_" };

-  
+

   $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;
   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) {
   foreach my $line (@_) {
     print {$SH} $line,"\r\n";
     if ($sigpipe) {


@@ -1054,17 +1063,29 @@ sub nvtsend {
       return 0;
     }
   }
       return 0;
     }
   }

-  
+

   return 1;
 }
 
 
   return 1;
 }
 
 

+sub quote {
+  local $_ = shift;
+  s/([^\w\@\/%^,.=+_:+-])/\\$1/g;
+  return $_;
+}
+
+
+sub debug {
+  print "## DEBUG: @_\n" if $DEBUG;
+}
+
+

 # from MIME::Base64::Perl
 sub encode_b64 {
   my $res = "";
   my $eol = "\n";
   my $padding;
 # from MIME::Base64::Perl
 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+/|;
   pos($_[0]) = 0;
   $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
   $res =~ tr|` -_|AA-Za-z0-9+/|;