Download.pm (7935B)
1 package SBO::Lib::Download; 2 3 use 5.016; 4 use strict; 5 use warnings; 6 7 our $VERSION = '2.9.0'; 8 9 use SBO::Lib::Util qw/ :const %config script_error get_sbo_from_loc open_read get_arch /; 10 use SBO::Lib::Repo qw/ $distfiles /; 11 use SBO::Lib::Info qw/ get_download_info /; 12 13 use Digest::MD5; 14 use URI (); 15 use Exporter 'import'; 16 17 our @EXPORT_OK = qw{ 18 check_distfiles 19 compute_md5sum 20 create_symlinks 21 get_distfile 22 get_dl_fns 23 get_filename_from_link 24 get_sbo_downloads 25 get_symlink_from_filename 26 verify_distfile 27 }; 28 29 our %EXPORT_TAGS = ( 30 all => \@EXPORT_OK, 31 ); 32 33 =pod 34 35 =encoding UTF-8 36 37 =head1 NAME 38 39 SBO::Lib::Download - Routines for downloading slackbuild sources. 40 41 =head1 SYNOPSIS 42 43 use SBO::Lib::Download qw/ check_distfiles /; 44 45 my ($ret, $exit) = check_distfiles(LOCATION => $loc); 46 47 =head2 SUBROUTINES 48 49 =cut 50 51 =head2 check_distfiles 52 53 my ($ret, $exit) = check_distfiles(LOCATION => $loc); 54 55 C<check_distfiles()> gets the list of downloads from C<$loc>, and checks to see 56 if any of them are already downloaded. If so, it verifies that they're correct, 57 otherwise it downloads them, verifies they're correct, and calls 58 C<create_symlinks> on them. 59 60 It returns a list of two values. If the second value is true, the first value 61 will contain an error message. Otherwise it will contain an array reference of 62 symlinks as returned by C<create_symlinks>. 63 64 =cut 65 66 # for the given location, pull list of downloads and check to see if any exist; 67 # if so, verify they md5 correctly and if not, download them and check the new 68 # download's md5sum, then create required symlinks for them. 69 sub check_distfiles { 70 my %args = ( 71 LOCATION => '', 72 COMPAT32 => 0, 73 @_ 74 ); 75 $args{LOCATION} or script_error('check_distfiles requires LOCATION.'); 76 77 my $location = $args{LOCATION}; 78 my $sbo = get_sbo_from_loc($location); 79 my $downloads = get_sbo_downloads( 80 LOCATION => $location, 81 32 => $args{COMPAT32} 82 ); 83 # return an error if we're unable to get download info 84 unless (keys %$downloads > 0) { 85 return "Unable to get download info from $location/$sbo.info\n", 86 _ERR_NOINFO; 87 } 88 for my $link (keys %$downloads) { 89 my $md5 = $downloads->{$link}; 90 unless (verify_distfile($link, $md5)) { 91 my ($fail, $exit) = get_distfile($link, $md5); 92 return $fail, $exit if $exit; 93 } 94 } 95 my $symlinks = create_symlinks($args{LOCATION}, $downloads); 96 return $symlinks; 97 } 98 99 =head2 compute_md5sum 100 101 my $md5sum = compute_md5sum($file); 102 103 C<compute_md5sum()> computes the md5sum of the file in C<$file>, and returns it. 104 105 =cut 106 107 # for a given file, compute its md5sum 108 sub compute_md5sum { 109 script_error('compute_md5sum requires a file argument.') unless -f $_[0]; 110 my ($fh, $exit) = open_read(shift); 111 my $md5 = Digest::MD5->new; 112 $md5->addfile($fh); 113 my $md5sum = $md5->hexdigest; 114 close $fh; 115 return $md5sum; 116 } 117 118 =head2 create_symlinks 119 120 my @symlinks = @{ create_symlinks($location, {%downloads}); 121 122 C<create_symlinks()> creates symlinks for the C<%downloads> in C<$location>, 123 and returns an array reference of the symlinks created. 124 125 =cut 126 127 # given a location and a list of download links, assemble a list of symlinks, 128 # and create them. 129 sub create_symlinks { 130 script_error('create_symlinks requires two arguments.') unless @_ == 2; 131 my ($location, $downloads) = @_; 132 my @symlinks; 133 for my $link (keys %$downloads) { 134 my $filename = get_filename_from_link($link); 135 my $symlink = get_symlink_from_filename($filename, $location); 136 push @symlinks, $symlink; 137 symlink $filename, $symlink; 138 } 139 return \@symlinks; 140 } 141 142 =head2 get_distfile 143 144 my ($msg, $err) = get_distfile($link, $md5); 145 146 C<get_distfile()> downloads the C<$link>, and compares the downloaded file's 147 md5sum to the one in C<$md5>. It returns a list of two values, and if the 148 second value is true, the first one will have an error message. 149 150 =cut 151 152 # for a given distfile, attempt to retrieve it and, if successful, check its 153 # md5sum against that in the sbo's .info file 154 sub get_distfile { 155 script_error('get_distfile requires two arguments') unless @_ == 2; 156 my ($link, $info_md5) = @_; 157 158 my $filename = get_filename_from_link($link); 159 mkdir $distfiles unless -d $distfiles; 160 chdir $distfiles; 161 162 my @links = $link; 163 my $fail = {}; 164 165 if ($config{FALLBACK_ARCHIVE} ne 'FALSE') { 166 my $uri = URI->new($link); 167 my @segments = $uri->path_segments(); 168 my $filename = $segments[-1]; 169 170 push(@links, sprintf( 171 "%s/by-md5/%s/%s/%s/%s", 172 $config{FALLBACK_ARCHIVE}, 173 substr($info_md5, 0, 1), substr($info_md5, 1, 1), $info_md5, $filename, 174 )); 175 } 176 177 for my $link (@links) { 178 unlink $filename if -f $filename; 179 180 if (system('wget', '--tries=5', $link) != 0) { 181 if (not %$fail) { 182 # The failure from the first source is apparently what is important. 183 $fail = {msg => "Unable to wget $link.\n", err => _ERR_DOWNLOAD}; 184 } 185 186 next; 187 } 188 189 if (not verify_distfile(@_)) { 190 if (not %$fail) { 191 $fail = {msg => "md5sum failure for $filename.\n", err => _ERR_MD5SUM}; 192 } 193 194 next; 195 } 196 197 return 1; 198 } 199 200 return $fail->{msg}, $fail->{err}; 201 } 202 203 =head2 get_dl_fns 204 205 my @filenames = @{ get_dl_fns([@links]) }; 206 207 C<get_dl_fns()> returns the filename parts of the C<@links> in an array 208 reference. 209 210 =cut 211 212 # given a list of downloads, return just the filenames 213 sub get_dl_fns { 214 my $fns = shift; 215 my $return; 216 push @$return, ($_ =~ qr|/([^/]+)$|)[0] for @$fns; 217 return $return; 218 } 219 220 =head2 get_filename_from_link 221 222 my $path = get_filename_from_link($link); 223 224 C<get_filename_from_link> returns the full path to the file downloaded from 225 C<$link>. 226 227 =cut 228 229 sub get_filename_from_link { 230 script_error('get_filename_from_link requires an argument') unless @_ == 1; 231 232 my $uri = URI->new(shift); 233 my @segments = $uri->path_segments(); 234 my $filename = $segments[-1]; 235 236 return undef unless length($filename); 237 return "$distfiles/$filename"; 238 } 239 240 =head2 get_sbo_downloads 241 242 my %downloads = %{ get_sbo_downloads(LOCATION => $loc) }; 243 244 C<get_sbo_downloads()> gets the download links and md5sums for the slackbuild 245 in $loc, and returns them in a hash reference. 246 247 =cut 248 249 # TODO: should probably combine this with get_download_info 250 sub get_sbo_downloads { 251 my %args = ( 252 LOCATION => '', 253 32 => 0, 254 @_ 255 ); 256 $args{LOCATION} or script_error('get_sbo_downloads requires LOCATION.'); 257 my $location = $args{LOCATION}; 258 -d $location or script_error('get_sbo_downloads given a non-directory.'); 259 my $arch = get_arch(); 260 my $dl_info; 261 if ($arch eq 'x86_64') { 262 $dl_info = get_download_info(LOCATION => $location) unless $args{32}; 263 } 264 unless (keys %$dl_info > 0) { 265 $dl_info = get_download_info(LOCATION => $location, X64 => 0); 266 } 267 return $dl_info; 268 } 269 270 =head2 get_symlink_from_filename 271 272 my $symlink = get_symlink_from_filename($path, $loc); 273 274 C<get_symlink_from_filename()> returns the path of the symlink in C<$loc> for 275 the C<$path>. 276 277 =cut 278 279 # for a given distfile, figure out what the full path to its symlink will be 280 sub get_symlink_from_filename { 281 script_error('get_symlink_from_filename requires two arguments') unless @_ == 2; 282 script_error('get_symlink_from_filename first argument is not a file') unless -f $_[0]; 283 my ($filename, $location) = @_; 284 return "$location/". ($filename =~ qr#/([^/]+)$#)[0]; 285 } 286 287 =head2 verify_distfile 288 289 my $bool = verify_distfile($link, $md5); 290 291 C<verify_distfile()> verifies that the file downloaded from C<$link> matches 292 the C<$md5> md5sum, and returns a true value if it does, and a false value 293 otherwise. 294 295 =cut 296 297 # for a given distfile, see whether or not it exists, and if so, if its md5sum 298 # matches the sbo's .info file 299 sub verify_distfile { 300 script_error('verify_distfile requires two arguments.') unless @_ == 2; 301 my ($link, $info_md5) = @_; 302 my $filename = get_filename_from_link($link); 303 return() unless -f $filename; 304 my $md5sum = compute_md5sum($filename); 305 return $info_md5 eq $md5sum ? 1 : 0; 306 } 307 308 1;