1# ex:ts=8 sw=4: 2# $OpenBSD: PackageRepository.pm,v 1.135 2016/09/15 12:53:08 espie Exp $ 3# 4# Copyright (c) 2003-2010 Marc Espie <espie@openbsd.org> 5# 6# Permission to use, copy, modify, and distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17 18use strict; 19use warnings; 20 21# XXX load extra class, grab match from Base class, and tweak inheritance 22# to get all methods. 23 24use OpenBSD::PackageRepository::Installed; 25$OpenBSD::PackageRepository::Installed::ISA = qw(OpenBSD::PackageRepository); 26 27package OpenBSD::PackageRepository; 28our @ISA=(qw(OpenBSD::PackageRepositoryBase)); 29 30use OpenBSD::PackageLocation; 31use OpenBSD::Paths; 32use OpenBSD::Error; 33use OpenBSD::Temp; 34 35sub make_error_file 36{ 37 my ($self, $object) = @_; 38 $object->{errors} = OpenBSD::Temp->file; 39 if (!defined $object->{errors}) { 40 $self->{state}->fatal("#1 not writable", 41 $OpenBSD::Temp::tempbase); 42 } 43} 44 45sub baseurl 46{ 47 my $self = shift; 48 49 return $self->{path}; 50} 51 52sub new 53{ 54 my ($class, $baseurl, $state) = @_; 55 my $o = $class->parse(\$baseurl, $state); 56 if ($baseurl ne '') { 57 return undef; 58 } 59 return $o; 60} 61 62sub can_be_empty 63{ 64 my $self = shift; 65 $self->{empty_okay} = 1; 66 return $self; 67} 68 69my $cache = {}; 70 71sub unique 72{ 73 my ($class, $o) = @_; 74 return $o unless defined $o; 75 if (defined $cache->{$o->url}) { 76 return $cache->{$o->url}; 77 } 78 $cache->{$o->url} = $o; 79 return $o; 80} 81 82my $cleanup = sub { 83 for my $repo (values %$cache) { 84 $repo->cleanup; 85 } 86}; 87END { 88 &$cleanup; 89} 90 91OpenBSD::Handler->register($cleanup); 92 93sub parse_fullurl 94{ 95 my ($class, $r, $state) = @_; 96 97 $class->strip_urlscheme($r) or return undef; 98 return $class->unique($class->parse_url($r, $state)); 99} 100 101sub dont_cleanup 102{ 103} 104 105sub ftp() { 'OpenBSD::PackageRepository::FTP' } 106sub http() { 'OpenBSD::PackageRepository::HTTP' } 107sub https() { 'OpenBSD::PackageRepository::HTTPS' } 108sub scp() { 'OpenBSD::PackageRepository::SCP' } 109sub file() { 'OpenBSD::PackageRepository::Local' } 110sub installed() { 'OpenBSD::PackageRepository::Installed' } 111 112sub parse 113{ 114 my ($class, $r, $state) = @_; 115 my $u = $$r; 116 return undef if $u eq ''; 117 118 if ($u =~ m/^ftp\:/io) { 119 return $class->ftp->parse_fullurl($r, $state); 120 } elsif ($u =~ m/^http\:/io) { 121# require OpenBSD::PackageRepository::HTTP; 122 123 return $class->http->parse_fullurl($r, $state); 124 } elsif ($u =~ m/^https\:/io) { 125 return $class->https->parse_fullurl($r, $state); 126 } elsif ($u =~ m/^scp\:/io) { 127 return undef if $state->defines("NO_SCP"); 128 129 require OpenBSD::PackageRepository::SCP; 130 131 return $class->scp->parse_fullurl($r, $state); 132 } elsif ($u =~ m/^file\:/io) { 133 return $class->file->parse_fullurl($r, $state); 134 } elsif ($u =~ m/^inst\:$/io) { 135 return $class->installed->parse_fullurl($r, $state); 136 } else { 137 if ($$r =~ m/^([a-z0-9][a-z0-9.]+\.[a-z0-9.]+)(\:|$)/ 138 && !-d $1) { 139 $$r =~ s//http:\/\/$1\/%m$2/; 140 return $class->http->parse_fullurl($r, $state); 141 } 142 return $class->file->parse_fullurl($r, $state); 143 } 144} 145 146sub available 147{ 148 my $self = shift; 149 150 return @{$self->list}; 151} 152 153sub stemlist 154{ 155 my $self = shift; 156 if (!defined $self->{stemlist}) { 157 require OpenBSD::PackageName; 158 my @l = $self->available; 159 if (@l == 0 && !$self->{empty_okay}) { 160 $self->{state}->errsay("#1 is empty", $self->url); 161 } 162 $self->{stemlist} = OpenBSD::PackageName::avail2stems(@l); 163 } 164 return $self->{stemlist}; 165} 166 167sub wipe_info 168{ 169 my ($self, $pkg) = @_; 170 171 require File::Path; 172 173 my $dir = $pkg->{dir}; 174 if (defined $dir) { 175 OpenBSD::Error->rmtree($dir); 176 OpenBSD::Temp->reclaim($dir); 177 delete $pkg->{dir}; 178 } 179} 180 181# by default, all objects may exist 182sub may_exist 183{ 184 return 1; 185} 186 187# by default, we don't track opened files for this key 188 189sub opened 190{ 191 undef; 192} 193 194# hint: 0 premature close, 1 real error. undef, normal ! 195 196sub close 197{ 198 my ($self, $object, $hint) = @_; 199 close($object->{fh}) if defined $object->{fh}; 200 if (defined $object->{pid2}) { 201 local $SIG{ALRM} = sub { 202 kill HUP => $object->{pid2}; 203 }; 204 alarm(30); 205 waitpid($object->{pid2}, 0); 206 alarm(0); 207 } 208 $self->parse_problems($object->{errors}, $hint, $object) 209 if defined $object->{errors}; 210 undef $object->{errors}; 211 $object->deref; 212} 213 214sub make_room 215{ 216 my $self = shift; 217 218 # kill old files if too many 219 my $already = $self->opened; 220 if (defined $already) { 221 # gc old objects 222 if (@$already >= $self->maxcount) { 223 @$already = grep { defined $_->{fh} } @$already; 224 } 225 while (@$already >= $self->maxcount) { 226 my $o = shift @$already; 227 $self->close_now($o); 228 } 229 } 230 return $already; 231} 232 233# open method that tracks opened files per-host. 234sub open 235{ 236 my ($self, $object) = @_; 237 238 return unless $self->may_exist($object->{name}); 239 240 # kill old files if too many 241 my $already = $self->make_room; 242 my $fh = $self->open_pipe($object); 243 if (!defined $fh) { 244 return; 245 } 246 $object->{fh} = $fh; 247 if (defined $already) { 248 push @$already, $object; 249 } 250 return $fh; 251} 252 253sub find 254{ 255 my ($repository, $name) = @_; 256 my $self = $repository->new_location($name); 257 258 if ($self->contents) { 259 return $self; 260 } 261} 262 263sub grabPlist 264{ 265 my ($repository, $name, $code) = @_; 266 my $self = $repository->new_location($name); 267 268 return $self->grabPlist($code); 269} 270 271sub parse_problems 272{ 273 my ($self, $filename, $hint, $object) = @_; 274 CORE::open(my $fh, '<', $filename) or return; 275 276 my $baseurl = $self->url; 277 my $url = $baseurl; 278 if (defined $object) { 279 $url = $object->url; 280 } 281 my $notyet = 1; 282 while(<$fh>) { 283 next if m/^(?:200|220|221|226|229|230|227|250|331|500|150)[\s\-]/o; 284 next if m/^EPSV command not understood/o; 285 next if m/^Trying [\da-f\.\:]+\.\.\./o; 286 next if m/^Requesting \Q$baseurl\E/; 287 next if m/^Remote system type is\s+/o; 288 next if m/^Connected to\s+/o; 289 next if m/^remote\:\s+/o; 290 next if m/^Using binary mode to transfer files/o; 291 next if m/^Retrieving\s+/o; 292 next if m/^Success?fully retrieved file/o; 293 next if m/^\d+\s+bytes\s+received\s+in/o; 294 next if m/^ftp: connect to address.*: No route to host/o; 295 296 if (defined $hint && $hint == 0) { 297 next if m/^ftp: -: short write/o; 298 next if m/^ftp: local: -: Broken pipe/o; 299 next if m/^ftp: Writing -: Broken pipe/o; 300 next if m/^421\s+/o; 301 } 302 s/.*unsigned .*archive.*/unsigned package/; 303 if ($notyet) { 304 $self->{state}->errsay("Error from #1", $url); 305 $notyet = 0; 306 } 307 if (m/^421\s+/o || 308 m/^ftp: connect: Connection timed out/o || 309 m/^ftp: Can't connect or login to host/o) { 310 $self->{lasterror} = 421; 311 } 312 # http error 313 if (m/^ftp: Error retrieving file: 404/o) { 314 $self->{lasterror} = 404; 315 } 316 if (m/^550\s+/o) { 317 $self->{lasterror} = 550; 318 } 319 $self->{state}->errprint("#1", $_); 320 } 321 CORE::close($fh); 322 OpenBSD::Temp->reclaim($filename); 323 unlink $filename; 324} 325 326sub cleanup 327{ 328 # nothing to do 329} 330 331sub relative_url 332{ 333 my ($self, $name) = @_; 334 if (defined $name) { 335 return $self->baseurl.$name.".tgz"; 336 } else { 337 return $self->baseurl; 338 } 339} 340 341sub add_to_list 342{ 343 my ($self, $list, $filename) = @_; 344 if ($filename =~ m/^(.*\-\d.*)\.tgz$/o) { 345 push(@$list, $1); 346 } 347} 348 349sub did_it_fork 350{ 351 my ($self, $pid) = @_; 352 if (!defined $pid) { 353 $self->{state}->fatal("Cannot fork: #1", $!); 354 } 355 if ($pid == 0) { 356 delete $SIG{'WINCH'}; 357 delete $SIG{'CONT'}; 358 delete $SIG{'INFO'}; 359 } 360} 361 362sub uncompress 363{ 364 my $self = shift; 365 my $object = shift; 366 require IO::Uncompress::Gunzip; 367 my $fh = IO::Uncompress::Gunzip->new(@_, MultiStream => 1); 368 my $result = ""; 369 if ($object->{is_signed}) { 370 my $h = $fh->getHeaderInfo; 371 if ($h) { 372 for my $line (split /\n/, $h->{Comment}) { 373 if ($line =~ m/^key=.*\/(.*)\.sec$/) { 374 $result .= "\@signer $1\n"; 375 } elsif ($line =~ m/^date=(.*)$/) { 376 $result .= "\@digital-signature signify2:$1:external\n"; 377 } 378 } 379 } 380 } 381 $object->{extra_content} = $result; 382 return $fh; 383} 384 385sub signify_pipe 386{ 387 my $self = shift; 388 my $object = shift; 389 CORE::open STDERR, ">>", $object->{errors}; 390 exec {OpenBSD::Paths->signify} 391 ("signify", 392 "-zV", 393 @_) 394 or $self->{state}->fatal("Can't run #1: #2", 395 OpenBSD::Paths->signify, $!); 396} 397 398sub check_signed 399{ 400 my ($self, $object) = @_; 401 if ($self->{state}{signature_style} eq 'new') { 402 $object->{is_signed} = 1; 403 return 1; 404 } else { 405 return 0; 406 } 407} 408 409package OpenBSD::PackageRepository::Local; 410our @ISA=qw(OpenBSD::PackageRepository); 411use OpenBSD::Error; 412 413sub is_local_file 414{ 415 return 1; 416} 417 418sub urlscheme 419{ 420 return 'file'; 421} 422 423my $pkg_db; 424 425sub pkg_db 426{ 427 if (!defined $pkg_db) { 428 use OpenBSD::Paths; 429 $pkg_db = $ENV{"PKG_DBDIR"} || OpenBSD::Paths->pkgdb; 430 } 431 return $pkg_db; 432} 433 434sub parse_fullurl 435{ 436 my ($class, $r, $state) = @_; 437 438 my $ok = $class->strip_urlscheme($r); 439 my $o = $class->parse_url($r, $state); 440 if (!$ok && $o->{path} eq $class->pkg_db."/") { 441 return $class->installed->new(0, $state); 442 } else { 443 return $class->unique($o); 444 } 445} 446 447# wrapper around copy, that sometimes does not copy 448sub may_copy 449{ 450 my ($self, $object, $destdir) = @_; 451 my $src = $self->relative_url($object->{name}); 452 require File::Spec; 453 my (undef, undef, $base) = File::Spec->splitpath($src); 454 my $dest = File::Spec->catfile($destdir, $base); 455 if (File::Spec->canonpath($dest) eq File::Spec->canonpath($src)) { 456 return; 457 } 458 if (-f $dest) { 459 my ($ddev, $dino) = (stat $dest)[0,1]; 460 my ($sdev, $sino) = (stat $src)[0, 1]; 461 if ($ddev == $sdev and $sino == $dino) { 462 return; 463 } 464 } 465 $self->{state}->copy_file($src, $destdir); 466} 467 468sub open_pipe 469{ 470 my ($self, $object) = @_; 471 if (defined $ENV{'PKG_CACHE'}) { 472 $self->may_copy($object, $ENV{'PKG_CACHE'}); 473 } 474 my $name = $self->relative_url($object->{name}); 475 if ($self->check_signed($object)) { 476 $self->make_error_file($object); 477 my $pid = open(my $fh, "-|"); 478 $self->did_it_fork($pid); 479 if ($pid) { 480 $object->{pid} = $pid; 481 return $self->uncompress($object, $fh); 482 } else { 483 $self->signify_pipe($object, "-x", $name); 484 } 485 } else { 486 return $self->uncompress($object, $name); 487 } 488} 489 490sub may_exist 491{ 492 my ($self, $name) = @_; 493 return -r $self->relative_url($name); 494} 495 496my $local = []; 497 498sub opened 499{ 500 return $local; 501} 502 503sub maxcount 504{ 505 return 3; 506} 507 508sub list 509{ 510 my $self = shift; 511 my $l = []; 512 my $dname = $self->baseurl; 513 opendir(my $dir, $dname) or return $l; 514 while (my $e = readdir $dir) { 515 next unless -f "$dname/$e"; 516 $self->add_to_list($l, $e); 517 } 518 close($dir); 519 return $l; 520} 521 522package OpenBSD::PackageRepository::Distant; 523our @ISA=qw(OpenBSD::PackageRepository); 524 525sub baseurl 526{ 527 my $self = shift; 528 529 return "//$self->{host}$self->{path}"; 530} 531 532sub parse_url 533{ 534 my ($class, $r, $state) = @_; 535 # same heuristics as ftp(1): 536 # find host part, rest is parsed as a local url 537 if (my ($host, $path) = $$r =~ m/^\/\/(.*?)(\/.*)$/) { 538 539 $$r = $path; 540 my $o = $class->SUPER::parse_url($r, $state); 541 $o->{host} = $host; 542 return $o; 543 } else { 544 return undef; 545 } 546} 547 548my $buffsize = 2 * 1024 * 1024; 549 550sub pkg_copy 551{ 552 my ($self, $in, $object) = @_; 553 554 my $name = $object->{name}; 555 my $dir = $object->{cache_dir}; 556 557 my ($copy, $filename) = OpenBSD::Temp::permanent_file($dir, $name) or die "Can't write copy to cache"; 558 chmod((0666 & ~umask), $filename); 559 $object->{tempname} = $filename; 560 my $handler = sub { 561 my ($sig) = @_; 562 unlink $filename; 563 close($in); 564 $SIG{$sig} = 'DEFAULT'; 565 kill $sig, $$; 566 }; 567 568 my $nonempty = 0; 569 my $error = 0; 570 { 571 572 local $SIG{'PIPE'} = $handler; 573 local $SIG{'INT'} = $handler; 574 local $SIG{'HUP'} = $handler; 575 local $SIG{'QUIT'} = $handler; 576 local $SIG{'KILL'} = $handler; 577 local $SIG{'TERM'} = $handler; 578 579 my ($buffer, $n); 580 # copy stuff over 581 do { 582 $n = sysread($in, $buffer, $buffsize); 583 if (!defined $n) { 584 $self->{state}->fatal("Error reading: #1", $!); 585 } 586 if ($n > 0) { 587 $nonempty = 1; 588 } 589 if (!$error) { 590 my $r = syswrite $copy, $buffer; 591 if (!defined $r || $r < $n) { 592 $error = 1; 593 } 594 } 595 syswrite STDOUT, $buffer; 596 } while ($n != 0); 597 close($copy); 598 } 599 600 if ($nonempty && !$error) { 601 rename $filename, "$dir/$name.tgz"; 602 } else { 603 unlink $filename; 604 } 605 close($in); 606} 607 608sub open_pipe 609{ 610 my ($self, $object) = @_; 611 $self->make_error_file($object); 612 my $d = $ENV{'PKG_CACHE'}; 613 if (defined $d) { 614 $object->{cache_dir} = $d; 615 if (! -d -w $d) { 616 $self->{state}->fatal("bad PKG_CACHE directory #1", $d); 617 } 618 $object->{cache_dir} = $d; 619 } 620 $object->{parent} = $$; 621 622 my ($rdfh, $wrfh); 623 624 pipe($rdfh, $wrfh); 625 my $pid2 = fork(); 626 $self->did_it_fork($pid2); 627 if ($pid2) { 628 $object->{pid2} = $pid2; 629 close($wrfh); 630 } else { 631 open STDERR, '>>', $object->{errors}; 632 open(STDOUT, '>&', $wrfh); 633 close($rdfh); 634 close($wrfh); 635 if (defined $d) { 636 my $pid3 = open(my $in, "-|"); 637 $self->did_it_fork($pid3); 638 if ($pid3) { 639 $self->dont_cleanup; 640 $self->pkg_copy($in, $object); 641 } else { 642 $self->grab_object($object); 643 } 644 } else { 645 $self->grab_object($object); 646 } 647 exit(0); 648 } 649 650 if ($self->check_signed($object)) { 651 my $pid = open(my $fh, "-|"); 652 $self->did_it_fork($pid); 653 if ($pid) { 654 $object->{pid} = $pid; 655 close($rdfh); 656 } else { 657 open(STDIN, '<&', $rdfh) or 658 $self->{state}->fatal("Bad dup: #1", $!); 659 close($rdfh); 660 $self->signify_pipe($object); 661 } 662 663 return $self->uncompress($object, $fh); 664 } else { 665 return $self->uncompress($object, $rdfh); 666 } 667} 668 669sub finish_and_close 670{ 671 my ($self, $object) = @_; 672 if (defined $object->{cache_dir}) { 673 while (defined $object->next) { 674 } 675 } 676 $self->SUPER::finish_and_close($object); 677} 678 679package OpenBSD::PackageRepository::HTTPorFTP; 680our @ISA=qw(OpenBSD::PackageRepository::Distant); 681 682our %distant = (); 683 684sub drop_privileges_and_setup_env 685{ 686 my $self = shift; 687 my $user = '_pkgfetch'; 688 if ($< == 0) { 689 # we can't cache anything, we happen after the fork, 690 # right before exec 691 if (my (undef, undef, $uid, $gid) = getpwnam($user)) { 692 $( = $gid; 693 $) = "$gid $gid"; 694 $< = $uid; 695 $> = $uid; 696 } else { 697 $self->{state}->fatal("Couldn't change identity: can't find #1 user", $user); 698 } 699 } else { 700 ($user) = getpwuid($<); 701 } 702 # create sanitized env for ftp 703 my %newenv = ( 704 HOME => '/var/empty', 705 USER => $user, 706 LOGNAME => $user, 707 SHELL => '/bin/sh', 708 LC_ALL => 'C', # especially, laundry error messages 709 PATH => '/bin:/usr/bin' 710 ); 711 712 # copy selected stuff; 713 for my $k (qw( 714 TERM 715 FTPMODE 716 FTPSERVER 717 FTPSERVERPORT 718 ftp_proxy 719 http_proxy 720 http_cookies 721 ALL_PROXY 722 FTP_PROXY 723 HTTPS_PROXY 724 HTTP_PROXY 725 NO_PROXY)) { 726 if (exists $ENV{$k}) { 727 $newenv{$k} = $ENV{$k}; 728 } 729 } 730 # don't forget to swap! 731 %ENV = %newenv; 732} 733 734 735sub grab_object 736{ 737 my ($self, $object) = @_; 738 my ($ftp, @extra) = split(/\s+/, OpenBSD::Paths->ftp); 739 $self->drop_privileges_and_setup_env; 740 exec {$ftp} 741 $ftp, 742 @extra, 743 "-o", 744 "-", $self->url($object->{name}) 745 or $self->{state}->fatal("Can't run #1: #2", OpenBSD::Paths->ftp, $!); 746} 747 748sub open_read_ftp 749{ 750 my ($self, $cmd, $errors) = @_; 751 my $child_pid = open(my $fh, '-|'); 752 if ($child_pid) { 753 $self->{pipe_pid} = $child_pid; 754 return $fh; 755 } else { 756 open STDERR, '>>', $errors if defined $errors; 757 758 $self->drop_privileges_and_setup_env; 759 exec($cmd) 760 or $self->{state}->fatal("Can't run #1: #2", $cmd, $!); 761 } 762} 763 764sub close_read_ftp 765{ 766 my ($self, $fh) = @_; 767 close($fh); 768 waitpid $self->{pipe_pid}, 0; 769} 770 771sub maxcount 772{ 773 return 1; 774} 775 776sub opened 777{ 778 my $self = $_[0]; 779 my $k = $self->{host}; 780 if (!defined $distant{$k}) { 781 $distant{$k} = []; 782 } 783 return $distant{$k}; 784} 785 786sub should_have 787{ 788 my ($self, $pkgname) = @_; 789 if (defined $self->{lasterror} && $self->{lasterror} == 421) { 790 return (defined $self->{list}) && 791 grep { $_ eq $pkgname } @{$self->{list}}; 792 } else { 793 return 0; 794 } 795} 796 797sub try_until_success 798{ 799 my ($self, $pkgname, $code) = @_; 800 801 for (my $retry = 5; $retry <= 160; $retry *= 2) { 802 undef $self->{lasterror}; 803 my $o = &$code; 804 if (defined $o) { 805 return $o; 806 } 807 if (defined $self->{lasterror} && 808 ($self->{lasterror} == 550 || $self->{lasterror} == 404)) { 809 last; 810 } 811 if ($self->should_have($pkgname)) { 812 $self->errsay("Temporary error, sleeping #1 seconds", 813 $retry); 814 sleep($retry); 815 } 816 } 817 return undef; 818} 819 820sub find 821{ 822 my ($self, $pkgname, @extra) = @_; 823 824 return $self->try_until_success($pkgname, 825 sub { 826 return $self->SUPER::find($pkgname, @extra); }); 827 828} 829 830sub grabPlist 831{ 832 my ($self, $pkgname, @extra) = @_; 833 834 return $self->try_until_success($pkgname, 835 sub { 836 return $self->SUPER::grabPlist($pkgname, @extra); }); 837} 838 839sub list 840{ 841 my ($self) = @_; 842 if (!defined $self->{list}) { 843 $self->make_room; 844 my $error = OpenBSD::Temp->file; 845 if (!defined $error) { 846 $self->{state}->fatal("#1 not writable", 847 $OpenBSD::Temp::tempbase); 848 } 849 $self->{list} = $self->obtain_list($error); 850 $self->parse_problems($error); 851 if ($self->{no_such_dir}) { 852 $self->{state}->errsay( 853 "#1: Directory does not exist on #2", 854 $self->{path}, $self->{host}); 855 $self->{lasterror} = 404; 856 } 857 } 858 return $self->{list}; 859} 860 861sub get_http_list 862{ 863 my ($self, $error) = @_; 864 865 my $fullname = $self->url; 866 my $l = []; 867 my $fh = $self->open_read_ftp(OpenBSD::Paths->ftp." -o - $fullname", 868 $error) or return; 869 while(<$fh>) { 870 chomp; 871 for my $pkg (m/\<A\s+HREF=\"(.*?\.tgz)\"\>/gio) { 872 $pkg = $1 if $pkg =~ m|^.*/(.*)$|; 873 # decode uri-encoding; from URI::Escape 874 $pkg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; 875 $self->add_to_list($l, $pkg); 876 } 877 } 878 $self->close_read_ftp($fh); 879 return $l; 880} 881 882package OpenBSD::PackageRepository::HTTP; 883our @ISA=qw(OpenBSD::PackageRepository::HTTPorFTP); 884 885sub urlscheme 886{ 887 return 'http'; 888} 889 890sub obtain_list 891{ 892 my ($self, $error) = @_; 893 return $self->get_http_list($error); 894} 895 896package OpenBSD::PackageRepository::HTTPS; 897our @ISA=qw(OpenBSD::PackageRepository::HTTP); 898 899sub urlscheme 900{ 901 return 'https'; 902} 903 904package OpenBSD::PackageRepository::FTP; 905our @ISA=qw(OpenBSD::PackageRepository::HTTPorFTP); 906 907sub urlscheme 908{ 909 return 'ftp'; 910} 911 912sub _list 913{ 914 my ($self, $cmd, $error) = @_; 915 my $l =[]; 916 my $fh = $self->open_read_ftp($cmd, $error) or return; 917 while(<$fh>) { 918 chomp; 919 next if m/^\d\d\d\s+\S/; 920 if (m/No such file or directory|Failed to change directory/i) { 921 $self->{no_such_dir} = 1; 922 } 923 next unless m/^(?:\.\/)?(\S+\.tgz)\s*$/; 924 $self->add_to_list($l, $1); 925 } 926 $self->close_read_ftp($fh); 927 return $l; 928} 929 930sub get_ftp_list 931{ 932 my ($self, $error) = @_; 933 934 my $fullname = $self->url; 935 return $self->_list("echo 'nlist'| ".OpenBSD::Paths->ftp 936 ." $fullname", $error); 937} 938 939sub obtain_list 940{ 941 my ($self, $error) = @_; 942 if (defined $ENV{'ftp_proxy'} && $ENV{'ftp_proxy'} ne '') { 943 return $self->get_http_list($error); 944 } else { 945 return $self->get_ftp_list($error); 946 } 947} 948 9491; 950