123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246 |
- # ex:ts=8 sw=4:
- # $OpenBSD: Fetch.pm,v 1.12 2017/04/14 16:43:40 espie Exp $
- #
- # Copyright (c) 2010-2013 Marc Espie <espie@openbsd.org>
- #
- # Permission to use, copy, modify, and distribute this software for any
- # purpose with or without fee is hereby granted, provided that the above
- # copyright notice and this permission notice appear in all copies.
- #
- # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
- # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
- # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
- # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
- # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
- # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
- # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
- use strict;
- use warnings;
- package DPB::Task::Checksum;
- our @ISA = qw(DPB::Task::Fork);
- sub new
- {
- my ($class, $fetcher, $status) = @_;
- bless {fetcher => $fetcher, fetch_status => $status}, $class;
- }
- sub run
- {
- my ($self, $core) = @_;
- my $job = $core->job;
- $job->{logger}->run_as(
- sub {
- $self->redirect_fh($job->{logfh}, $job->{log});
- });
- exit(!$job->{file}->checksum($job->{file}->tempfilename));
- }
- sub finalize
- {
- my ($self, $core) = @_;
- $self->SUPER::finalize($core);
- my $job = $core->job;
- if ($core->{status} != 0) {
- # XXX if we continued, and it failed, then maybe we
- # got a stupid error message instead, so retry for
- # full size.
- if (defined $self->{fetcher}->{initial_sz}) {
- $job->{fetcher}->run_as(
- sub {
- unlink($job->{file}->tempfilename);
- });
- } else {
- shift @{$job->{sites}};
- }
- return $job->bad_file($self->{fetcher}, $core);
- }
- $job->{fetcher}->run_as(
- sub {
- rename($job->{file}->tempfilename, $job->{file}->filename);
- });
- print {$job->{logfh}} "Renamed to ", $job->{file}->filename, "\n";
- $job->{file}->cache;
- my $sz = $job->{file}->{sz};
- if (defined $self->{fetcher}->{initial_sz}) {
- $sz -= $self->{fetcher}->{initial_sz};
- }
- my $fh = $job->{file}->logger->append("fetch/good");
- my $elapsed = $self->{fetcher}->elapsed;
- print $fh $self->{fetcher}{site}.$job->{file}->{short}, " in ",
- $elapsed, "s ";
- if ($elapsed != 0) {
- print $fh "(", sprintf("%.2f", $sz / $elapsed / 1024), "KB/s)";
- }
- print $fh "\n";
- close $fh;
- return 1;
- }
- # Fetching stuff is almost a normal job
- package DPB::Task::Fetch;
- our @ISA = qw(DPB::Task::Clocked);
- sub stopped_clock
- {
- my ($self, $gap) = @_;
- # note that we're missing time
- $self->{got_suspended}++;
- $self->SUPER::stopped_clock($gap);
- }
- sub new
- {
- my ($class, $job) = @_;
- if (@{$job->{sites}}) {
- my $o = bless { site => $job->{sites}[0]}, $class;
- my $sz = (stat $job->{file}->tempfilename)[7];
- if (defined $sz) {
- $o->{initial_sz} = $sz;
- }
- return $o;
- } else {
- undef;
- }
- }
- sub run
- {
- my ($self, $core) = @_;
- my $job = $core->job;
- my $site = $self->{site};
- $site =~ s/^\"(.*)\"$/$1/;
- $job->{logger}->run_as(
- sub {
- $self->redirect($job->{log});
- });
- if ($job->{file}{sz} == 0) {
- print STDERR "No size in distinfo\n";
- exit(1);
- }
- my $ftp = OpenBSD::Paths->ftp;
- my @cmd = ('-C', '-o', $job->{file}->tempfilename, '-v',
- $site.$job->{file}->{short});
- if ($ftp =~ /\s/) {
- unshift @cmd, split(/\s+/, $ftp);
- } else {
- unshift @cmd, $ftp;
- }
- print STDERR "===> Trying $site\n";
- print STDERR join(' ', @cmd), "\n";
- # run ftp;
- $core->shell->nochroot->exec(@cmd);
- }
- sub finalize
- {
- my ($self, $core) = @_;
- $self->SUPER::finalize($core);
- my $job = $core->job;
- if ($job->{file}->checksize($job->{file}->tempfilename)) {
- $job->new_checksum_task($self, $core->{status});
- } else {
- if ($job->{file}{sz} == 0) {
- $job->{sites} = [];
- return $job->bad_file($self, $core);
- }
- # Fetch exited okay, but the file is not the right size
- if ($core->{status} == 0 ||
- # definite error also if file is too large
- stat($job->{file}->tempfilename) &&
- (stat _)[7] > $job->{file}->{sz}) {
- $job->{fetcher}->unlink($job->{file}->tempfilename);
- }
- # if we got suspended, well, might have to retry same site
- if (!$self->{got_suspended}) {
- shift @{$job->{sites}};
- }
- return $job->bad_file($self, $core);
- }
- }
- package DPB::Job::Fetch;
- our @ISA = qw(DPB::Job::Normal);
- use File::Path;
- use File::Basename;
- sub new_fetch_task
- {
- my $self = shift;
- my $task = DPB::Task::Fetch->new($self);
- if ($task) {
- push(@{$self->{tasks}}, $task);
- $self->{tries}++;
- return 1;
- } else {
- return 0;
- }
- }
- sub bad_file
- {
- my ($job, $task, $core) = @_;
- my $fh = $job->{file}->logger->append("fetch/bad");
- print $fh $task->{site}.$job->{file}->{short}, "\n";
- if ($job->new_fetch_task) {
- $core->{status} = 0;
- return 1;
- } else {
- $core->{status} = 1;
- return 0;
- }
- }
- sub new_checksum_task
- {
- my ($self, $fetcher, $status) = @_;
- push(@{$self->{tasks}}, DPB::Task::Checksum->new($fetcher, $status));
- }
- sub new
- {
- my ($class, $file, $e, $fetcher, $logger) = @_;
- my $job = bless {
- sites => [@{$file->{site}}],
- file => $file,
- tasks => [],
- endcode => $e,
- fetcher => $fetcher,
- logger => $logger,
- log => $file->logger->make_distlogs($file),
- }, $class;
- $job->{logfh} = $job->{logger}->open('>>', $job->{log});
- print {$job->{logfh}} ">>> From ", $file->fullpkgpath, "\n";
- $job->{fetcher}->make_path(File::Basename::dirname($file->filename));
- $job->{watched} = DPB::Watch->new(
- $job->{fetcher}->file($file->tempfilename),
- $file->{sz}, undef, $job->{started});
- $job->new_fetch_task;
- return $job;
- }
- sub name
- {
- my $self = shift;
- return '<'.$self->{file}->{name}."(#".$self->{tries}.")";
- }
- sub watched
- {
- my ($self, $current, $core) = @_;
- my $w = $self->{watched};
- my $diff = $w->check_change($current);
- my $msg = $w->percent_message . $w->frozen_message($diff);
- return $self->kill_on_timeout($diff, $core, $msg);
- }
- sub get_timeout
- {
- my ($self, $core) = @_;
- return $core->fetch_timeout;
- }
- 1;
|