Repo.pm (12046B)
1 package SBO::Lib::Repo; 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/ %config prompt usage_error get_slack_version get_slack_version_key get_slack_version_url script_error open_fh open_read in _ERR_DOWNLOAD /; 10 use SBO::Lib::Cryptography qw/ GOODSIG NO_PUBKEY parse_gpg_output verify_gpg_signed_file /; 11 12 use Cwd; 13 use File::Copy; 14 use File::Find; 15 use File::Temp "tempdir"; 16 use File::Path qw/ make_path remove_tree /; 17 use IPC::Open3; 18 use Sort::Versions; 19 use Symbol "gensym"; 20 21 use Exporter 'import'; 22 23 our @EXPORT_OK = qw{ 24 check_git_remote 25 check_repo 26 chk_slackbuilds_txt 27 fetch_tree 28 generate_slackbuilds_txt 29 git_sbo_tree 30 migrate_repo 31 pull_sbo_tree 32 rsync_sbo_tree 33 slackbuilds_or_fetch 34 update_tree 35 36 $distfiles 37 $repo_path 38 $slackbuilds_txt 39 }; 40 41 our %EXPORT_TAGS = ( 42 all => \@EXPORT_OK, 43 ); 44 45 =pod 46 47 =encoding UTF-8 48 49 =head1 NAME 50 51 SBO::Lib::Repo - Routines for downloading and updating the SBo repo. 52 53 =head1 SYNOPSIS 54 55 use SBO::Lib::Repo qw/ fetch_tree /; 56 57 fetch_tree(); 58 59 =head1 VARIABLES 60 61 =head2 $distfiles 62 63 By default $distfiles is set to C</usr/sbo/distfiles>, and it is where all the 64 downloaded sources are kept. 65 66 The location depends on the C<SBO_HOME> config setting. 67 68 =head2 $repo_path 69 70 By default $repo_path is set to C</usr/sbo/repo>, and it is where the 71 SlackBuilds.org tree is kept. 72 73 The location depends on the C<SBO_HOME> config setting. 74 75 =cut 76 77 # some stuff we'll need later 78 our $distfiles = "$config{SBO_HOME}/distfiles"; 79 our $repo_path = "$config{SBO_HOME}/repo"; 80 our $slackbuilds_txt = "$repo_path/SLACKBUILDS.TXT"; 81 82 =head1 SUBROUTINES 83 84 =cut 85 86 =head2 check_git_remote 87 88 my $bool = check_git_remote($path, $url); 89 90 C<check_git_remote()> will check if the repository at C<$path> is a git 91 repository and if so, it will check if it defined an C<origin> remote that 92 matches the C<$url>. If so, it will return a true value. Otherwise it will 93 return a false value. 94 95 =cut 96 97 sub check_git_remote { 98 script_error('check_git_remote requires two arguments.') unless @_ == 2; 99 my ($path, $url) = @_; 100 return 0 unless -f "$path/.git/config"; 101 my ($fh, $exit) = open_read("$path/.git/config"); 102 return 0 if $exit; 103 104 while (my $line = readline($fh)) { 105 chomp $line; 106 if ($line eq '[remote "origin"]') { 107 REMOTE: while (my $remote = readline($fh)) { 108 last REMOTE if $remote =~ /^\[/; 109 return 1 if $remote =~ /^\s*url\s*=\s*\Q$url\E$/; 110 return 0 if $remote =~ /^\s*url\s*=/; 111 } 112 } 113 } 114 return 0; 115 } 116 117 =head2 check_repo 118 119 my $bool = check_repo(); 120 121 C<check_repo()> checks if the path in C<$repo_path> exists and is an empty 122 directory, and returns a true value if so. 123 124 If it exists but isn't empty, it will exit with a usage error. 125 126 If it doesn't exist, it will attempt to create it and return a true value. If 127 it fails to create it, it will exit with a usage error. 128 129 =cut 130 131 sub check_repo { 132 if (-d $repo_path) { 133 _race::cond '$repo_path could be deleted after -d check'; 134 opendir(my $repo_handle, $repo_path); 135 FIRST: while (my $dir = readdir $repo_handle) { 136 next FIRST if in($dir => qw/ . .. /); 137 usage_error("$repo_path exists and is not empty. Exiting.\n"); 138 } 139 } else { 140 eval { make_path($repo_path) } 141 or usage_error("Unable to create $repo_path.\n"); 142 } 143 return 1; 144 } 145 146 =head2 chk_slackbuilds_txt 147 148 my $bool = chk_slackbuilds_txt(); 149 150 C<chk_slackbuilds_txt()> checks if the file C<SLACKBUILDS.TXT> exists in the 151 correct location, and returns a true value if it does, and a false value 152 otherwise. 153 154 Before the check is made, it attempts to call C<migrate_repo()> so it doesn't 155 give a false negative if the repository hasn't been migrated to its sbotools 156 2.0 location yet. 157 158 =cut 159 160 # does the SLACKBUILDS.TXT file exist in the sbo tree? 161 sub chk_slackbuilds_txt { 162 if (-f "$config{SBO_HOME}/SLACKBUILDS.TXT") { migrate_repo(); } 163 return -f $slackbuilds_txt ? 1 : undef; 164 } 165 166 =head2 fetch_tree 167 168 fetch_tree(); 169 170 C<fetch_tree()> will make sure the C<$repo_path> exists and is empty, and then 171 fetch the SlackBuilds.org repository tree there. 172 173 If the C<$repo_path> is not empty, it will exit with a usage error. 174 175 =cut 176 177 sub fetch_tree { 178 check_repo(); 179 say 'Pulling SlackBuilds tree...'; 180 pull_sbo_tree(), return 1; 181 } 182 183 =head2 generate_slackbuilds_txt 184 185 my $bool = generate_slackbuilds_txt(); 186 187 C<generate_slackbuilds_txt()> will generate a minimal C<SLACKBUILDS.TXT> for a 188 repository that doesn't come with one. If it fails, it will return a false 189 value. Otherwise it will return a true value. 190 191 =cut 192 193 sub generate_slackbuilds_txt { 194 my ($fh, $exit) = open_fh($slackbuilds_txt, '>'); 195 return 0 if $exit; 196 197 opendir(my $dh, $repo_path) or return 0; 198 my @categories = 199 grep { -d "$repo_path/$_" } 200 grep { $_ !~ /^\./ } 201 readdir($dh); 202 close $dh; 203 204 for my $cat (@categories) { 205 opendir(my $cat_dh, "$repo_path/$cat") or return 0; 206 while (my $package = readdir($cat_dh)) { 207 next if in($package => qw/ . .. /); 208 next unless -f "$repo_path/$cat/$package/$package.info"; 209 print { $fh } "SLACKBUILD NAME: $package\n"; 210 print { $fh } "SLACKBUILD LOCATION: ./$cat/$package\n"; 211 } 212 close $cat_dh; 213 } 214 close $fh; 215 return 1; 216 } 217 218 sub latest_git_tag { 219 my $version = shift; 220 my $tag = ''; 221 222 open(my $std_out, "git tag |") or die("dead"); 223 while (my $line = <$std_out>) { 224 if ($line =~ /^$version-/) { 225 $tag = $line; 226 } 227 } 228 close($std_out); 229 230 chomp($tag); 231 232 return $tag; 233 } 234 235 =head2 git_sbo_tree 236 237 my $bool = git_sbo_tree($url, $key_id); 238 239 C<git_sbo_tree()> will C<git clone> the repository specified by C<$url> to the 240 C<$repo_path> if the C<$url> repository isn't already there. If it is, it will 241 run C<git fetch && git reset --hard origin>. 242 243 If any command fails, it will return a false value. Otherwise it will return a 244 true value. 245 246 =cut 247 248 sub git_sbo_tree { 249 script_error('git_sbo_tree requires two arguments.') unless @_ == 2; 250 my $url = shift; 251 my $key_id = shift; 252 253 my $cwd = getcwd(); 254 255 if ((! -d "$repo_path/.git") || ! check_git_remote($repo_path, $url)) { 256 chdir $config{SBO_HOME} or return 0; 257 258 remove_tree($repo_path) if -d $repo_path; 259 if (system(qw/ git clone --no-local /, $url, $repo_path)) { 260 return 0; 261 } 262 } 263 264 _race::cond '$repo_path can be deleted after -d check'; 265 chdir($repo_path) or return 0; 266 267 return 0 unless system("git fetch") == 0; 268 269 unlink "$repo_path/SLACKBUILDS.TXT"; 270 271 my $git_ref = 'origin'; 272 my $verify_cmd = 'verify-commit'; 273 274 my $tag = latest_git_tag(get_slack_version()); 275 if ($tag ne '') { 276 $git_ref = $tag; 277 $verify_cmd = 'verify-tag'; 278 } 279 280 if ($key_id) { 281 my @output; 282 283 print("Verifying $git_ref..."); 284 open3(undef, undef, my $std_err = gensym, "git", $verify_cmd, "--raw", "$git_ref"); 285 while (my $line = <$std_err>) { 286 push(@output, $line); 287 } 288 close($std_err); 289 290 my $res = parse_gpg_output(\@output, $key_id); 291 if ($res eq GOODSIG) { 292 print("OK\n"); 293 } else { 294 print(STDERR "Repository GPG verification failed: $res."); 295 if ($res == NO_PUBKEY) { 296 print(STDERR " Did you import the GPG key?"); 297 } 298 print(STDERR "\n"); 299 300 chdir $cwd; 301 return 0; 302 } 303 } 304 305 _race::cond 'git repo could be changed or deleted here'; 306 return 0 unless system('git', 'reset', '--hard', $git_ref) == 0; 307 308 _race::cond '$cwd could be deleted here'; 309 return 0 unless chdir $cwd; 310 311 return 1; 312 } 313 314 =head2 migrate_repo 315 316 migrate_repo(); 317 318 C<migrate_repo()> moves an old sbotools 1.x repository to the location it needs 319 to be in for sbotools 2.x. This means every directory and file except for the 320 C<distfiles> directory in (by default) C</usr/sbo/> gets moved to 321 C</usr/sbo/repo>. 322 323 =cut 324 325 # Move everything in /usr/sbo except distfiles and repo dirs into repo dir 326 sub migrate_repo { 327 make_path($repo_path) unless -d $repo_path; 328 _race::cond '$repo_path can be deleted between being made and being used'; 329 opendir(my $dh, $config{SBO_HOME}); 330 foreach my $entry (readdir($dh)) { 331 next if in($entry => qw/ . .. repo distfiles /); 332 move("$config{SBO_HOME}/$entry", "$repo_path/$entry"); 333 } 334 close $dh; 335 } 336 337 =head2 pull_sbo_tree 338 339 pull_sbo_tree(); 340 341 C<pull_sbo_tree()> will pull the SlackBuilds.org repository tree from 342 C<rsync://slackbuilds.org/slackbuilds/$ver/> or whatever the C<REPO> 343 configuration variable has been set to. 344 345 C<$ver> is the version of Slackware you're running, provided it is supported, 346 or whatever you've set in the C<SLACKWARE_VERSION> configuration variable. 347 348 =cut 349 350 sub pull_sbo_tree { 351 my $url = $config{REPO}; 352 if ($url eq 'FALSE') { 353 $url = get_slack_version_url(); 354 } else { 355 unlink($slackbuilds_txt); 356 } 357 358 my $key_id = ''; 359 if ($config{GPG_KEY} ne 'FALSE') { 360 $key_id = $config{GPG_KEY}; 361 }; 362 363 my $res = 0; 364 if ($url =~ m!^rsync://!) { 365 $res = rsync_sbo_tree($url, $key_id); 366 } else { 367 $res = git_sbo_tree($url, $key_id); 368 } 369 370 if ($res == 0) { 371 warn "Could not sync from $url.\n"; 372 if ($url eq 'https://github.com/Ponce/slackbuilds.git' && $key_id ne '') { 373 warn "This URL is known not to use GPG verification. You likely want to disable with 'sboconfig --gpg-key FALSE'." 374 } 375 exit _ERR_DOWNLOAD; 376 } 377 378 my $wanted = sub { chown 0, 0, $File::Find::name; }; 379 find($wanted, $repo_path) if -d $repo_path; 380 if ($res and not chk_slackbuilds_txt()) { 381 generate_slackbuilds_txt(); 382 } 383 } 384 385 =head2 rsync_sbo_tree 386 387 my $bool = rsync_sbo_tree($url, $key_id); 388 389 C<rsync_sbo_tree()> syncs the SlackBuilds.org repository to C<$repo_path> from 390 the C<$url> provided. 391 392 =cut 393 394 # rsync the sbo tree from slackbuilds.org to $repo_path 395 sub rsync_sbo_tree { 396 script_error('rsync_sbo_tree requires two arguments.') unless @_ == 2; 397 398 my $url = shift; 399 $url .= '/' unless $url =~ m!/$!; # make sure $url ends with / 400 my $key_id = shift; 401 402 my @info; 403 # only slackware versions above 14.1 have an rsync that supports --info=progress2 404 if (versioncmp(get_slack_version(), '14.1') == 1) { @info = ('--info=progress2'); } 405 406 my @args = ('rsync', @info, '-a', '--delete', $url); 407 return 0 unless system(@args, $repo_path) == 0; 408 409 my $cwd = getcwd(); 410 chdir($repo_path); 411 412 if ($key_id) { 413 if (versioncmp(get_slack_version(), '14.1') == -1) { 414 print("GPG verification is not present for 14.0 and earlier. You should consider disabling GPG verification.") 415 } 416 417 print("Verifying CHECKSUMS.md5..."); 418 my $res = verify_gpg_signed_file('CHECKSUMS.md5.asc', $key_id); 419 if ($res eq GOODSIG) { 420 print("OK\n"); 421 } else { 422 print(STDERR "Respository CHECKSUMS.md5 GPG verification failed: $res."); 423 if ($res eq NO_PUBKEY) { 424 print(STDERR " Did you import the GPG key?"); 425 } 426 print(STDERR "\n"); 427 428 chdir($cwd); 429 return 0; 430 } 431 } 432 433 if ( -e "CHECKSUMS.md5" ) { 434 print("Verifying file integrity using CHECKSUMS.md5..."); 435 if (system('tail +13 CHECKSUMS.md5 | md5sum -c --quiet -')) { 436 chdir($cwd); 437 return 0; 438 } 439 print("OK\n"); 440 } 441 442 return chdir($cwd); 443 } 444 445 =head2 slackbuilds_or_fetch 446 447 slackbuilds_or_fetch(); 448 449 C<slackbuilds_or_fetch()> will check if there is a C<SLACKBUILDS.TXT> in the 450 C<$repo_path>, and if not, offer to run C<sbosnap fetch> for you. 451 452 =cut 453 454 # if the SLACKBUILDS.TXT is not in $repo_path, we assume the tree has 455 # not been populated there; prompt the user to automagickally pull the tree. 456 sub slackbuilds_or_fetch { 457 unless (chk_slackbuilds_txt()) { 458 say 'It looks like you haven\'t run "sbosnap fetch" yet.'; 459 if (($< == 0) && prompt("Would you like me to do this now?", default => 'yes')) { 460 fetch_tree(); 461 } else { 462 say 'Please run "sbosnap fetch" as root'; 463 exit 0; 464 } 465 } 466 return 1; 467 } 468 469 =head2 update_tree 470 471 update_tree(); 472 473 C<update_tree()> will check if there is a C<SLACKBUILDS.TXT> in the 474 C<$repo_path>, and if not, will run C<fetch_tree()>. Otherwise it will update 475 the SlackBuilds.org tree. 476 477 =cut 478 479 sub update_tree { 480 fetch_tree(), return() unless chk_slackbuilds_txt(); 481 say 'Updating SlackBuilds tree...'; 482 pull_sbo_tree(), return 1; 483 } 484 485 1;