cmd/download.pl

   1 #
   2 # download a file from t'internet
   3 #
   4 # A build in, non-spawning, wget -Qn
   5 #
   6 # Copyright 2023 Dirk Koopman G1TLH
   7 #
   8
   9 #use IO::Socket::SSL;
  10 use File::Copy;
  11
  12 my %h;
  13
  14 sub handle
  15 {
  16         my $self = shift;
  17         return (1, $self->msg('e5')) if $self->priv < 9 || $self->remotecmd;
  18         my $url = unpad(shift);
  19         my $dest = unpad(shift) if @_;
  20         dbg("download: url $url");
  21         my $ua = Mojo::UserAgent->new->insecure(1)->max_redirects(5);
  22         my $res = $ua->get($url => sub {finish(@_, $self, $ua)});
  23         $self->{$res} = $res;
  24         dbg("ua $ua start: $url") if isdbg('download');
  25 }
  26
  27 sub finish {
  28         my ($ua, $tx, $self, $ua) = @_;
  29
  30 #       $DB::single = 1;
  31
  32         my $res = $tx->res;
  33
  34         if ($res->is_success) {
  35                 #dbg("body: " . $res->body) if isdbg('download');
  36                 my $tmp = localdata("tmp");
  37                 mkdir $tmp, 0777 unless -e $tmp;
  38                 my $path = $tx->req->url->to_abs->path;
  39                 my @parts = split m|/|, $path;
  40                 my $fn = $parts[-1];
  41                 dbg("ua $ua temp file: $tmp/$fn") if isdbg('download');
  42                 $res->save_to("$tmp/$fn");
  43                 my $target = localdata($fn);
  44                 if (-e "$tmp/$fn") {
  45                         LogDbg('dxcommand', "moving $tmp/$fn -> $target from ");
  46                         move "$tmp/$fn", $target;
  47                         unlink "$tmp/$fn";
  48                 }
  49                 dbg("download: $target successfully downloaded") if isdbg('progress')
  50         } elsif ($res->is_error) {
  51                 dbg("ua $ua err: " . $res->error) if isdbg('download');
  52         } elsif ($res->code == 301) {
  53                 dbg("redirect: " . $res->headers->location)
  54         } else {
  55                 dbg("something else: " . $res->error->{message});
  56         }
  57         delete $self->{$res};
  58 }