user-tools/dlnew

   1 #!/usr/bin/env perl
   2
   3 use LWP::Simple;
   4 use Date::Parse;
   5 use Data::Dumper;
   6 eval q{ use Linux::UserXAttr ':all'; };
   7 $use_xattr = $@ ? 0 : 1;
   8 use Getopt::Long;
   9 use POSIX;
  10 use Errno ':POSIX';
  11 use constant {EC_DOWNLOADED=>0, EC_ERROR=>1, EC_CACHED=>2, EC_NOTOK=>3, EC_NOTMODIFIED=>4, EC_NOTUPDATED=>5,};
  12 use constant {XATTR_URL=>"user.xdg.origin.url", XATTR_CACHECONTROL=>"user.cache.control", XATTR_MAXAGE=>"user.cache.control.max_age", XATTR_EXPIRES=>"user.cache.expires",};
  13
  14 $now = time;
  15 $use_caching = 1;
  16 GetOptions(
  17         'C!' => sub{ $use_caching = 0; },
  18 )or die;
  19
  20 ($url, $file) = @ARGV;
  21 ($file) = $url =~ /([^\/]+)$/ if not $file;
  22
  23 exit main($url, $file);
  24
  25
  26
  27 sub delxattr
  28 {
  29         if(not removexattr(@_))
  30         {
  31                 return 0 unless $!{ENOTSUP} or $!{ENOATTR} or $!{ENODATA};
  32         }
  33         1;
  34 }
  35
  36 sub file_mtime { return((stat $_[0])[9]); }
  37 sub file_atime { return((stat $_[0])[8]); }
  38
  39 sub process_response
  40 {
  41         my ($data, $rsp, $prt) = @_;
  42         my $file = $GLOB{file};
  43         my $chunk_n = ++$GLOB{chunk_n};
  44
  45         sub cb_return { die join(' ', @_)."\n"; }
  46
  47         if($chunk_n == 1)
  48         {
  49                 my $file_mtime;
  50
  51                 if(not $rsp->is_success)
  52                 {
  53                         cb_return EC_NOTOK;
  54                 }
  55                 if(-e $file)
  56                 {
  57                         $file_mtime = file_mtime($file);
  58                 }
  59
  60                 my $url_mtime = str2time($rsp->header("Last-Modified"));
  61                 if(defined $url_mtime)
  62                 {
  63                         if($url_mtime <= $file_mtime)
  64                         {
  65                                 cb_return EC_NOTUPDATED;
  66                         }
  67                         $GLOB{url_mtime} = $url_mtime;
  68                 }
  69
  70                 my $expires = $rsp->header("Expires");
  71                 my $cache_control = $rsp->header("Cache-Control");
  72                 my $maxage;
  73
  74                 if($cache_control =~ /\b(s-maxage)=(\d+)/i)
  75                 {
  76                         $maxage = $2;
  77                 }
  78                 elsif($cache_control =~ /\b(max-age)=(\d+)/i)
  79                 {
  80                         $maxage = $2;
  81                 }
  82
  83                 open $GLOB{'fh'}, '>', $file or cb_return EC_ERROR, "$file: $!";
  84
  85                 if($use_xattr)
  86                 {
  87                         # https://www.freedesktop.org/wiki/CommonExtendedAttributes/
  88                         setxattr($GLOB{'fh'}, XATTR_URL, $rsp->request()->uri) or warn "setxattr: $!\n";
  89                         if(defined $cache_control)
  90                         {
  91                                 setxattr($GLOB{'fh'}, XATTR_CACHECONTROL, $cache_control) or warn "setxattr: $!\n";
  92                         }
  93                         else
  94                         {
  95                                 delxattr($GLOB{'fh'}, XATTR_CACHECONTROL) or warn "removexattr: $!\n";
  96                         }
  97                         if(defined $maxage)
  98                         {
  99                                 setxattr($GLOB{'fh'}, XATTR_MAXAGE, $maxage) or warn "setxattr: $!\n";
 100                         }
 101                         else
 102                         {
 103                                 delxattr($GLOB{'fh'}, XATTR_MAXAGE) or warn "removexattr: $!\n";
 104                         }
 105                         if(defined $expires)
 106                         {
 107                                 setxattr($GLOB{'fh'}, XATTR_EXPIRES, $expires) or warn "setxattr: $!\n";
 108                         }
 109                         else
 110                         {
 111                                 delxattr($GLOB{'fh'}, XATTR_EXPIRES) or warn "removexattr: $!\n";
 112                         }
 113                 }
 114         }
 115
 116         print {$GLOB{'fh'}} $data or cb_return EC_ERROR, "$file: $!";
 117 }
 118
 119 sub time2rfc
 120 {
 121         my ($localtime) = @_;
 122         my $lc_time = POSIX::setlocale(POSIX::LC_TIME);
 123         POSIX::setlocale(POSIX::LC_TIME, "C");
 124         my $str = POSIX::strftime("%a, %d %b %Y %T %Z", localtime $localtime);
 125         POSIX::setlocale(POSIX::LC_TIME, $lc_time);
 126         return $str;
 127 }
 128
 129 sub main
 130 {
 131         my ($url, $file) = @_;
 132         my $local_expires;
 133         my $local_maxage;
 134         my %headers;
 135
 136         if(-e $file)
 137         {
 138                 my $file_mtime = file_mtime($file);
 139                 if($use_xattr and $use_caching)
 140                 {
 141                         my $local_maxage = getxattr($file, XATTR_MAXAGE);
 142                         my $local_expires = getxattr($file, XATTR_EXPIRES);
 143                         if(defined $local_maxage)
 144                         {
 145                                 if($file_mtime + $local_maxage > $now)
 146                                 {
 147                                         return EC_CACHED;
 148                                 }
 149                         }
 150                         elsif(defined $local_expires)
 151                         {
 152                                 if(str2time($local_expires) > $now)
 153                                 {
 154                                         return EC_CACHED;
 155                                 }
 156                         }
 157                 }
 158                 $headers{"If-Modified-Since"} = time2rfc($file_mtime);
 159         }
 160
 161         my $ua = LWP::UserAgent->new;
 162         %GLOB = (file => $file);
 163         my $rsp = $ua->get($url, ':content_cb' => \&process_response, %headers);
 164
 165         if($rsp->is_success)
 166         {
 167                 my ($rc, $msg) = split /\s+/, $rsp->header("X-Died"), 2;
 168                 if(defined $rc)
 169                 {
 170                         warn "$msg\n" if $msg;
 171                         return $rc;
 172                 }
 173                 close $GLOB{'fh'};
 174                 if(defined $GLOB{url_mtime})
 175                 {
 176                         utime file_atime($file), $GLOB{url_mtime}, $file or warn "$file: $!\n";
 177                 }
 178                 return EC_DOWNLOADED;
 179         }
 180         else
 181         {
 182                 warn "HTTP " . $rsp->code . " " . $rsp->message . "\n";
 183                 if($rsp->code == 304)
 184                 {
 185                         return EC_NOTMODIFIED;
 186                 }
 187                 return EC_NOTOK;
 188         }
 189 }
 190
 191
 192 =pod
 193
 194 =head1 NAME
 195
 196 dlnew - Download web resource if local copy is older
 197
 198 =head1 SYNOPSIS
 199
 200 dlnew [-C] <B<url>> <B<file>>
 201
 202 =head1 DESCRIPTION
 203
 204 Download content from web if newer than local copy (based on Last-Modified and caching headers).
 205
 206 =head1 PARAMETERS
 207
 208 =over 8
 209
 210 =item B<-C>
 211
 212 Bypass validating cache.
 213
 214 =item B<url>
 215
 216 URL to be downloaded. Schema can be HTTP or HTTPS.
 217
 218 =item B<file>
 219
 220 Local file data have to written in. If omitted, last component (basename) of B<url> will be used.
 221
 222 =back
 223
 224 =head1 EXIT STATUS
 225
 226 =over 8
 227
 228 =item B<0>
 229
 230 B<Url> ia found and downloaded.
 231
 232 =item B<1>
 233
 234 General error, system errors.
 235
 236 =item B<2>
 237
 238 Local B<file>'s freshness validated by saved cache metadata, not downloaded.
 239
 240 =item B<3>
 241
 242 Download not OK. (usually Not Found)
 243
 244 =item B<4>
 245
 246 B<Url> found but not modified. (HTTP 304)
 247
 248 =item B<5>
 249
 250 B<Url> found but not updated, based on Last-Modified header.
 251
 252 =back
 253
 254 =cut