summaryrefslogtreecommitdiff
path: root/Master/tlpkg/archive/TLDownload.pm.complicated_way
blob: 409f707af9664ce5b64b12c07ff8342a0d82bc06 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
# $Id: TLDownload.pm -1   $
# TeXLive::TLDownload.pm - module for abstracting the download modes
# Copyright 2009 Norbert Preining
#
# This file is licensed under the GNU General Public License version 2
# or any later version.
#
# TODO:
# - retrials for opening the connections are now implemented (see
#   $RETRIES and $SLEEP_BETWEEN_RETRIES)
#   retrials for getting files are not implemented (and I am not sure
#   if it makes sense)
# - re-opening of a dropped connection, detection of dropped connection?
#   in ftp mode we check that we can send the pwd command before getting
#   a file. If this does not succeed we try to reopen the connection
#   In http mode I don't know.
# - timeout for ftp: default is AFAIR 120sec, that is probably not enough
#   for a normal user to select all options and go press/enter "i"nstall
#   either extend timeout or care for reopening of closed connections
#   See above, for ftp that should be fixed by automatic reopening.
#


package TeXLive::TLDownload;

use TeXLive::TLUtils;
use File::Temp qw/tempfile/;

my $svnrev = '$Revision: -1 $';
my $_modulerevision;
if ($svnrev =~ m/: ([0-9]+) /) {
  $_modulerevision = $1;
} else {
  $_modulerevision = "unknown";
}
sub module_revision {
  return $_modulerevision;
}


my $CONNECT_RETRIES = 5;
my $SLEEP_BETWEEN_CONNECT_RETRIES = 2; # (in seconds)
my $GET_RETRIES = 5;
my $SLEEP_BETWEEN_GET_RETRIES = 10; # (in seconds)


# since Net::HTTP and Net::FTP are shipped by the same packages
# we only test for Net::HTTP, if that fails, let us know ;-)
our $net_lib_avail = 0;
eval { require Net::HTTP; };
if ($@) {
  debug("Net::HTTP is not available, falling back to wget mode.\n");
  $net_lib_avail = 0;
} else {
  require Net::HTTP;
  require Net::FTP;
  require HTTP::Status;
  $net_lib_avail = 1;
  debug("Net::HTTP available!\n");
}


sub new
{
  my $class = shift;
  my %params = @_;
  my $self = {
    server      => $params{'server'},
    mode        => defined($params{'mode'}) ? $params{'mode'} : "wget",
  };
  if ($self->{'mode'} eq "http" ||
      $self->{'mode'} eq "ftp") {
    die "Net::HTTP and Net::FTP is not available, cannot use http/ftp mode."
      if (!$net_lib_avail);
  } elsif ($self->{'mode'} eq "wget") {
    # noting to be done
  } else {
    die "Unknown download mode: ", $self->{'mode'};
  }
  bless $self, $class;
  return $self;
}



sub start_connection
{
  my $self = shift;
  if ($self->mode eq "wget") {
    debug("TLDownload::start_connection: no need to call start_connection in wget mode\n");
    return 1;
  }
  if (!defined($self->server)) {
    die "TLDownload::start_connection: No server defined, cannot start connection.";
  }
  if (($self->mode eq "http") || ($self->mode eq "ftp")) {
    my $handle;
    for my $tries (1..$CONNECT_RETRIES) {
      if ($self->mode eq "http") {
        $handle = Net::HTTP->new(Host => $self->server, KeepAlive => 1);
      } else {
        $handle = Net::FTP->new($self->server, Debug => 0);
      }
      if ($handle) {
        debug("TLDownload::start_connection: succeeded.\n");
        last; # of $tries
      }
      sleep($SLEEP_BETWEEN_CONNECT_RETRIES);
    }
    # if still not have a handle give up
    if (!$handle) {
      tlwarn("TLDownload::start_connection: Could not connect to server " . $self->server . " ($CONNECT_RETRIES trials), giving up.\n");
      return 0;
    }
    if ($self->mode eq "ftp") {
      # special ftp stuff
      if (!$handle->login("anonymous",'-texlive@')) {
        tlwarn("TLDownload::start_connection: Cannot login to server: " . $handle->message . "\n");
        return 0;
      }
      if (!$handle->binary) {
        tlwarn("TLDownload::start_connection: Cannot set transfer mode to binary: " . $handle->message . "\n");
        return 0;
      }
    }
    # again for both http and ftp
    # now we got a handle, save it simply into $self for later reuse
    $self->{'handle'} = $handle;
    return 1;
  }
  # we are still here, that cannot be
  return 0;
}



sub get_file
{
  my ($self, $url, $out, $size) = @_;
  #
  # first split the $url into components. we might get a full url
  # or some relative path
  my $protocol;
  my $server;
  my $path;
  if ($url =~ m!^(http|ftp)://([^/]*)(/.*)$!i) {
    $protocol = lc($1);
    $server = lc($2);
    $path = $3;
  } elsif ($url =~ m!^/.*$!) {
    $path = $url;
  } else {
    tlwarn("TLDownload::get_file: do not understand that url: $url\n");
    return 0;
  }
  #
  # wget case
  # simple fall back to TLUtils::_download_file
  #
  if ($self->mode eq "wget") {
    if (!defined($protocol)) {
      tlwarn("TLDownload::get_file: cannot download relative url $url in wget mode.\n");
      return 0;
    }
    my $wget;
    if (defined($::progs{'wget'})) {
      $wget = $progs->{'wget'};
    } else {
      tlwarn ("TLDownload::get_file: programs not set up, trying literal wget\n");
      $wget = "wget";
    }
    return TeXLive::TLUtils::_download_file($url, $out, $wget);
  }
  #
  # check for incompatible server names or protocols
  #
  if (defined($protocol) && ($protocol ne $self->mode)) {
    tlwarn("TLDownload::get_file: protocols mismatch, url uses $protocol, server " . $self->mode . ".\n");
    return 0;
  }
  if (defined($server) && ($server ne lc($self->server))) {
    tlwarn("TLDownload::get_file: server mismatch, url uses $server, but current download server is " . $self->server . ".\n");
    return 0;
  }
  #
  # for both http and ftp we want to support the destination "|" which
  # should return a file handle.
  my $realout = $out;
  if ($out eq "|") {
    my $outfh = tempfile();
    $realout = $outfh;
  }
  #
  # ftp mode
  #
  if ($self->mode eq "ftp") {
    # test if handle is alive:
    if (defined($self->{'handle'})) {
      if (!$handle->pwd) {
        # connection droped, time-out or similar ...
        # delete the handle so that the following code restarts the
        # connection
        delete($self->{'handle'});
      }
    }
    if (!defined($self->{'handle'})) {
      if (!$self->start_connection) {
        # warnings are already issued by start_connection
        # which also does retrials
        return;
      }
    }
    # now we should have a $handle
    my $handle = $self->{'handle'};
    my $got_it = 0;
    for my $tries (1..$GET_RETRIES) {
      if ($handle->get($path, $realout)) {
        $got_it = 1;
        last;
      }
      sleep($SLEEP_BETWEEN_GET_RETRIES);
    }
    if (!$got_it) {
      tlwarn("TLDownload::get_file: Could not get $path:\n");
      tlwarn($handle->message . "\n");
      tlwarn("($GET_RETRIES trials), giving up.\n");
      return;
    }
    return 1;
  }
  #
  # http mode
  #
  if ($self->mode eq "http") {
    if (!defined($self->{'handle'})) {
      if (!$self->start_connection) {
        # start_connection already warns ...
        return 0;
      }
    }
    # now we should have a $handle
    my $handle = $self->{'handle'};
    my $got_it = 0;
    for my $tries (1..$GET_RETRIES) {
      if ($handle->write_request(GET => $path, 'User-Agent' => 'texlive (net::http)')) {
        $got_it = 1;
        last;
      }
      sleep($SLEEP_BETWEEN_GET_RETRIES);
    }
    if (!$got_it) {
      tlwarn("TLDownload::get_file: Could not send GET request.\n");
      tlwarn("($GET_RETRIES trials), giving up.\n");
      return;
    }
    my ($code, $msg, %h) = $handle->read_response_headers;
    if (HTTP::Status::is_error($code)) {
      tlwarn("Problem downloading from server ($code): $msg\n");
      return;
    }
    my $buffer = "";
    my $bytes_read = 0;
    while (1) {
      my $buf;
      my $n = $handle->read_entity_body($buf, (defined($size) ? $size : 4096));
      if (!defined($n)) {
        tlwarn("TLDownload::get_file: Cannot read file from server: $!\n");
        return 0;
      }
      last unless $n;
      dddebug("- http read got $n bytes\n");
      $bytes_read += $n;
      $buffer .= $buf;
    }
    if (defined($size) && ($bytes_read != $size)) {
      tlwarn("TLDownload::get_file: didn't get $size bytes, expect breakage\n");
    }
    my $outhandle;
    if ($out ne "|") {
      if (!open (OUT, ">$out")) {
        tlwarn("TLDownload::get_file: cannot open $out for writing: $!\n");
        return 0;
      }
      $outhandle = \*OUT;
    } else {
      $outhandle = $realout;
    }
    binmode($outhandle);
    print $outhandle $buffer;
    if ($out ne "|") {
      if (!close(OUT)) {
        tlwarn("TLDownload::get_file: strange, cannot close file handle ...\n");
      }
      return 1;
    } else {
      # seek to beginning of file
      seek $outhandle, 0, 0;
      return $outhandle;
    }
  }
  #
  # we are still here, strange
  #
  tlwarn("TLDownload::get_file: still around, strange, mode = " . $self->mode . "\n");
  return 0;
}



sub mode
{
  my $self = shift;
  if (@_) { $self->{'mode'} = shift }
  return $self->{'mode'};
}
sub server
{
  my $self = shift;
  if (@_) { $self->{'server'} = shift }
  return $self->{'server'};
}

1;
__END__


=head1 NAME

C<TeXLive::TLDownload> -- TeX Live Download abstraction module

=head1 SYNOPSIS

  use TeXLive::TLDownload;

  $TeXLive::TLDownload::net_lib_avail
  my $dl = TeXLive::TLDownload->new(server => "www.foo.com", mode => "http");
  my $dl = TeXLive::TLDownload->new(server => "www.foo.com", mode => "ftp");
  my $dl = TeXLive::TLDownload->new(server => "http://www.foo.com", mode => "wget");
  $dl->start_connection;
  $dl->get_file($relpath, $output [, $expected_size ]);

=head1 DESCRIPTION

The C<TeXLive::TLDownload> module handles TeX Live Download abstractions
to make it possible to use persistent network connections instead of
calling wget for each single file. It depends on the modules Net::HTTP
and Net::FTP, and will check for these at loading time. If they are
not present only "wget" mode will be available.

=head1 SEE ALSO


=head1 AUTHORS AND COPYRIGHT

This script and its documentation were written for the TeX Live
distribution (L<http://tug.org/texlive>) and both are licensed under the
GNU General Public License Version 2 or later.

=cut

### Local Variables:
### perl-indent-level: 2
### tab-width: 2
### indent-tabs-mode: nil
### End:
# vim:set tabstop=2 expandtab: #