1-- This file is covered by the Internet Software Consortium (ISC) License 2-- Reference: ../License.txt 3 4with Ada.Command_Line; 5with Ada.Strings.Fixed; 6with PortScan.Ops; 7with PortScan.Packages; 8with PortScan.Buildcycle.Ports; 9with PortScan.Buildcycle.Pkgsrc; 10with Signals; 11with Unix; 12 13package body PortScan.Pilot is 14 15 package CLI renames Ada.Command_Line; 16 package ASF renames Ada.Strings.Fixed; 17 package OPS renames PortScan.Ops; 18 package PKG renames PortScan.Packages; 19 package CYC renames PortScan.Buildcycle; 20 package FPC renames PortScan.Buildcycle.Ports; 21 package NPS renames PortScan.Buildcycle.Pkgsrc; 22 package SIG renames Signals; 23 24 --------------------- 25 -- store_origins -- 26 --------------------- 27 function store_origins return Boolean 28 is 29 function trimmed_catport (S : String) return String; 30 function trimmed_catport (S : String) return String 31 is 32 last : constant Natural := S'Last; 33 begin 34 if S (last) = '/' then 35 return S (S'First .. last - 1); 36 else 37 return S (S'First .. last); 38 end if; 39 end trimmed_catport; 40 begin 41 if CLI.Argument_Count <= 1 then 42 return False; 43 end if; 44 portlist.Clear; 45 load_index_for_store_origins; 46 47 if CLI.Argument_Count = 2 then 48 -- Check if this is a file 49 declare 50 Arg2 : constant String := trimmed_catport (CLI.Argument (2)); 51 vfresult : Boolean; 52 begin 53 if AD.Exists (Arg2) then 54 vfresult := valid_file (Arg2); 55 clear_store_origin_data; 56 return vfresult; 57 end if; 58 if input_origin_valid (candidate => Arg2) then 59 if Arg2 /= pkgng then 60 plinsert (Arg2, 2); 61 end if; 62 clear_store_origin_data; 63 return True; 64 else 65 suggest_flavor_for_bad_origin (candidate => Arg2); 66 clear_store_origin_data; 67 return False; 68 end if; 69 end; 70 end if; 71 for k in 2 .. CLI.Argument_Count loop 72 declare 73 Argk : constant String := trimmed_catport (CLI.Argument (k)); 74 begin 75 if input_origin_valid (candidate => Argk) then 76 if Argk /= pkgng then 77 plinsert (Argk, k); 78 end if; 79 else 80 suggest_flavor_for_bad_origin (candidate => Argk); 81 clear_store_origin_data; 82 return False; 83 end if; 84 end; 85 end loop; 86 clear_store_origin_data; 87 return True; 88 end store_origins; 89 90 91 ------------------------------- 92 -- prerequisites_available -- 93 ------------------------------- 94 function prerequisites_available return Boolean is 95 begin 96 case software_framework is 97 when ports_collection => return build_pkg8_as_necessary; 98 when pkgsrc => return build_pkgsrc_prerequisites; 99 end case; 100 end prerequisites_available; 101 102 103 ------------------------------- 104 -- build_pkg8_as_necessary -- 105 ------------------------------- 106 function build_pkg8_as_necessary return Boolean 107 is 108 pkg_good : Boolean; 109 good_scan : Boolean; 110 stop_now : Boolean; 111 selection : PortScan.port_id; 112 result : Boolean := True; 113 begin 114 OPS.initialize_hooks; 115 REP.initialize (testmode => False, num_cores => PortScan.cores_available); 116 REP.launch_slave (id => PortScan.scan_slave, opts => noprocs); 117 good_scan := PortScan.scan_single_port (catport => pkgng, 118 always_build => False, 119 fatal => stop_now); 120 121 if good_scan then 122 PortScan.set_build_priority; 123 else 124 TIO.Put_Line ("Unexpected pkg(8) scan failure!"); 125 result := False; 126 goto clean_exit; 127 end if; 128 129 PKG.limited_sanity_check 130 (repository => JT.USS (PM.configuration.dir_repository), 131 dry_run => False, suppress_remote => True); 132 133 if SIG.graceful_shutdown_requested or else PKG.queue_is_empty then 134 goto clean_exit; 135 end if; 136 137 CYC.initialize (test_mode => False, jail_env => REP.jail_environment); 138 selection := OPS.top_buildable_port; 139 if SIG.graceful_shutdown_requested or else selection = port_match_failed 140 then 141 goto clean_exit; 142 end if; 143 TIO.Put ("Stand by, building pkg(8) first ... "); 144 145 pkg_good := FPC.build_package (id => PortScan.scan_slave, 146 sequence_id => selection); 147 OPS.run_hook_after_build (pkg_good, selection); 148 149 if not pkg_good then 150 TIO.Put_Line ("Failed!!" & bailing); 151 result := False; 152 goto clean_exit; 153 end if; 154 155 TIO.Put_Line ("done!"); 156 157 <<clean_exit>> 158 if SIG.graceful_shutdown_requested then 159 TIO.Put_Line (shutreq); 160 result := False; 161 end if; 162 REP.destroy_slave (id => PortScan.scan_slave, opts => noprocs); 163 REP.finalize; 164 reset_ports_tree; 165 return result; 166 167 end build_pkg8_as_necessary; 168 169 170 ---------------------------------- 171 -- build_pkgsrc_prerequisites -- 172 ---------------------------------- 173 function build_pkgsrc_prerequisites return Boolean 174 is 175 function scan_it (the_catport : String) return Boolean; 176 function build_it (desc : String) return Boolean; 177 178 mk_files : constant String := "pkgtools/bootstrap-mk-files"; 179 cp_bmake : constant String := "devel/bmake"; 180 cp_digest : constant String := "pkgtools/digest"; 181 result : Boolean := True; 182 183 function scan_it (the_catport : String) return Boolean 184 is 185 good_scan : Boolean; 186 stop_now : Boolean; 187 begin 188 good_scan := PortScan.scan_single_port (catport => the_catport, 189 always_build => False, 190 fatal => stop_now); 191 if good_scan then 192 PortScan.set_build_priority; 193 else 194 TIO.Put_Line ("Unexpected " & the_catport & " scan failure!"); 195 return False; 196 end if; 197 198 PKG.limited_sanity_check 199 (repository => JT.USS (PM.configuration.dir_repository), 200 dry_run => False, suppress_remote => True); 201 202 if SIG.graceful_shutdown_requested then 203 return False; 204 end if; 205 206 return True; 207 end scan_it; 208 209 function build_it (desc : String) return Boolean 210 is 211 pkg_good : Boolean; 212 selection : PortScan.port_id; 213 begin 214 CYC.initialize (test_mode => False, jail_env => REP.jail_environment); 215 selection := OPS.top_buildable_port; 216 if SIG.graceful_shutdown_requested or else selection = port_match_failed 217 then 218 return False; 219 end if; 220 TIO.Put ("Stand by, building " & desc & " package ... "); 221 pkg_good := NPS.build_package (id => PortScan.scan_slave, 222 sequence_id => selection); 223 OPS.run_hook_after_build (pkg_good, selection); 224 if not pkg_good then 225 TIO.Put_Line ("Failed!!" & bailing); 226 return False; 227 end if; 228 TIO.Put_Line ("done!"); 229 return True; 230 end build_it; 231 begin 232 OPS.initialize_hooks; 233 REP.initialize (testmode => False, num_cores => PortScan.cores_available); 234 REP.launch_slave (id => PortScan.scan_slave, opts => npsboot); 235 if not PLAT.host_pkgsrc_mk_install (id => PortScan.scan_slave) or else 236 not PLAT.host_pkgsrc_bmake_install (id => PortScan.scan_slave) or else 237 not PLAT.host_pkgsrc_pkg8_install (id => PortScan.scan_slave) 238 then 239 TIO.Put_Line ("Failed to install programs from host system."); 240 result := False; 241 goto clean_exit; 242 end if; 243 244 result := scan_it (mk_files); 245 if not result then 246 goto clean_exit; 247 end if; 248 249 if not PKG.queue_is_empty then 250 -- the mk files package does not exist or requires rebuilding 251 result := build_it ("mk files"); 252 if not result then 253 goto clean_exit; 254 end if; 255 end if; 256 reset_ports_tree; 257 258 result := scan_it (cp_bmake); 259 if not result then 260 goto clean_exit; 261 end if; 262 263 if not PKG.queue_is_empty then 264 -- the bmake package does not exist or requires rebuilding 265 result := build_it ("bmake"); 266 if not result then 267 goto clean_exit; 268 end if; 269 end if; 270 reset_ports_tree; 271 272 result := scan_it (cp_digest); 273 if not result then 274 goto clean_exit; 275 end if; 276 277 if not PKG.queue_is_empty then 278 -- the digest package does not exist or requires rebuilding 279 result := build_it ("digest"); 280 if not result then 281 goto clean_exit; 282 end if; 283 end if; 284 reset_ports_tree; 285 286 result := scan_it (pkgng); 287 if not result then 288 goto clean_exit; 289 end if; 290 291 if not PKG.queue_is_empty then 292 -- the pkg(8) package does not exist or requires rebuilding 293 result := build_it ("pkg(8)"); 294 end if; 295 296 <<clean_exit>> 297 if SIG.graceful_shutdown_requested then 298 TIO.Put_Line (shutreq); 299 result := False; 300 end if; 301 REP.destroy_slave (id => PortScan.scan_slave, opts => noprocs); 302 REP.finalize; 303 reset_ports_tree; 304 return result; 305 306 end build_pkgsrc_prerequisites; 307 308 309 ---------------------------------- 310 -- scan_stack_of_single_ports -- 311 ---------------------------------- 312 function scan_stack_of_single_ports (testmode : Boolean; 313 always_build : Boolean := False) 314 return Boolean 315 is 316 procedure scan (plcursor : portkey_crate.Cursor); 317 successful : Boolean := True; 318 just_stop_now : Boolean; 319 320 procedure scan (plcursor : portkey_crate.Cursor) 321 is 322 origin : constant String := JT.USS (portkey_crate.Key (plcursor)); 323 begin 324 if not successful then 325 return; 326 end if; 327 if origin = pkgng then 328 -- we've already built pkg(8) if we get here, just skip it 329 return; 330 end if; 331 if SIG.graceful_shutdown_requested then 332 successful := False; 333 return; 334 end if; 335 if not PortScan.scan_single_port (origin, always_build, just_stop_now) 336 then 337 if just_stop_now then 338 successful := False; 339 else 340 TIO.Put_Line 341 ("Scan of " & origin & " failed" & PortScan.obvious_problem 342 (JT.USS (PM.configuration.dir_portsdir), origin) & 343 ", it will not be considered."); 344 end if; 345 end if; 346 end scan; 347 348 begin 349 REP.initialize (testmode, PortScan.cores_available); 350 REP.launch_slave (id => PortScan.scan_slave, opts => noprocs); 351 if SIG.graceful_shutdown_requested then 352 goto clean_exit; 353 end if; 354 if not PLAT.standalone_pkg8_install (PortScan.scan_slave) then 355 TIO.Put_Line ("Failed to install pkg(8) scanner" & bailing); 356 successful := False; 357 goto clean_exit; 358 end if; 359 portlist.Iterate (Process => scan'Access); 360 if successful then 361 PortScan.set_build_priority; 362 if PKG.queue_is_empty then 363 successful := False; 364 TIO.Put_Line ("There are no valid ports to build." & bailing); 365 end if; 366 end if; 367 368 <<clean_exit>> 369 if SIG.graceful_shutdown_requested then 370 successful := False; 371 TIO.Put_Line (shutreq); 372 end if; 373 REP.destroy_slave (id => PortScan.scan_slave, opts => noprocs); 374 REP.finalize; 375 return successful; 376 end scan_stack_of_single_ports; 377 378 379 --------------------------------- 380 -- sanity_check_then_prefail -- 381 --------------------------------- 382 function sanity_check_then_prefail (delete_first : Boolean := False; 383 dry_run : Boolean := False) 384 return Boolean 385 is 386 procedure force_delete (plcursor : portkey_crate.Cursor); 387 ptid : PortScan.port_id; 388 num_skipped : Natural; 389 block_remote : Boolean := True; 390 update_external_repo : constant String := host_pkg8 & 391 " update --quiet --repository "; 392 no_packages : constant String := 393 "No prebuilt packages will be used as a result."; 394 395 procedure force_delete (plcursor : portkey_crate.Cursor) 396 is 397 origin : JT.Text := portkey_crate.Key (plcursor); 398 pndx : constant port_index := ports_keys.Element (origin); 399 tball : constant String := JT.USS (PM.configuration.dir_repository) & 400 "/" & JT.USS (all_ports (pndx).package_name); 401 begin 402 if AD.Exists (tball) then 403 AD.Delete_File (tball); 404 end if; 405 end force_delete; 406 begin 407 start_time := CAL.Clock; 408 409 if delete_first and then not dry_run then 410 portlist.Iterate (Process => force_delete'Access); 411 end if; 412 413 case software_framework is 414 when ports_collection => 415 if not PKG.limited_cached_options_check then 416 -- Error messages emitted by function 417 return False; 418 end if; 419 when pkgsrc => 420 -- There's no analog to cached options on pkgsc. 421 -- We could detect unused settings, but that's it. 422 -- And maybe that should be detected by the framework itself 423 null; 424 end case; 425 426 if PM.configuration.defer_prebuilt then 427 -- Before any remote operations, find the external repo 428 if PKG.located_external_repository then 429 block_remote := False; 430 -- We're going to use prebuilt packages if available, so let's 431 -- prepare for that case by updating the external repository 432 TIO.Put ("Stand by, updating external repository catalogs ... "); 433 if not Unix.external_command (update_external_repo & 434 PKG.top_external_repository) 435 then 436 TIO.Put_Line ("Failed!"); 437 TIO.Put_Line ("The external repository could not be updated."); 438 TIO.Put_Line (no_packages); 439 block_remote := True; 440 else 441 TIO.Put_Line ("done."); 442 end if; 443 else 444 TIO.Put_Line ("The external repository does not seem to be " & 445 "configured."); 446 TIO.Put_Line (no_packages); 447 end if; 448 end if; 449 450 OPS.run_start_hook; 451 PKG.limited_sanity_check 452 (repository => JT.USS (PM.configuration.dir_repository), 453 dry_run => dry_run, suppress_remote => block_remote); 454 bld_counter := (OPS.queue_length, 0, 0, 0, 0); 455 if dry_run then 456 return True; 457 end if; 458 if SIG.graceful_shutdown_requested then 459 TIO.Put_Line (shutreq); 460 return False; 461 end if; 462 463 OPS.delete_existing_web_history_files; 464 465 start_logging (total); 466 start_logging (ignored); 467 start_logging (skipped); 468 start_logging (success); 469 start_logging (failure); 470 471 loop 472 ptid := OPS.next_ignored_port; 473 exit when ptid = PortScan.port_match_failed; 474 exit when SIG.graceful_shutdown_requested; 475 bld_counter (ignored) := bld_counter (ignored) + 1; 476 TIO.Put_Line (Flog (total), CYC.elapsed_now & " " & 477 OPS.port_name (ptid) & " has been ignored: " & 478 OPS.ignore_reason (ptid)); 479 TIO.Put_Line (Flog (ignored), CYC.elapsed_now & " " & 480 OPS.port_name (ptid) & ": " & 481 OPS.ignore_reason (ptid)); 482 OPS.cascade_failed_build (id => ptid, 483 numskipped => num_skipped, 484 logs => Flog); 485 OPS.record_history_ignored (elapsed => CYC.elapsed_now, 486 origin => OPS.port_name (ptid), 487 reason => OPS.ignore_reason (ptid), 488 skips => num_skipped); 489 bld_counter (skipped) := bld_counter (skipped) + num_skipped; 490 end loop; 491 stop_logging (ignored); 492 TIO.Put_Line (Flog (total), CYC.elapsed_now & " Sanity check complete. " 493 & "Ports remaining to build:" & OPS.queue_length'Img); 494 TIO.Flush (Flog (total)); 495 if SIG.graceful_shutdown_requested then 496 TIO.Put_Line (shutreq); 497 else 498 if OPS.integrity_intact then 499 return True; 500 end if; 501 end if; 502 -- If here, we either got control-C or failed integrity check 503 if not SIG.graceful_shutdown_requested then 504 TIO.Put_Line ("Queue integrity lost! " & bailing); 505 end if; 506 stop_logging (total); 507 stop_logging (skipped); 508 stop_logging (success); 509 stop_logging (failure); 510 return False; 511 end sanity_check_then_prefail; 512 513 514 ------------------------ 515 -- perform_bulk_run -- 516 ------------------------ 517 procedure perform_bulk_run (testmode : Boolean) 518 is 519 num_builders : constant builders := PM.configuration.num_builders; 520 show_tally : Boolean := True; 521 begin 522 if PKG.queue_is_empty then 523 TIO.Put_Line ("After inspection, it has been determined that there " & 524 "are no packages that"); 525 TIO.Put_Line ("require rebuilding; the task is therefore complete."); 526 show_tally := False; 527 else 528 REP.initialize (testmode, PortScan.cores_available); 529 CYC.initialize (testmode, REP.jail_environment); 530 OPS.initialize_web_report (num_builders); 531 OPS.initialize_display (num_builders); 532 OPS.parallel_bulk_run (num_builders, Flog); 533 REP.finalize; 534 end if; 535 stop_time := CAL.Clock; 536 stop_logging (total); 537 stop_logging (success); 538 stop_logging (failure); 539 stop_logging (skipped); 540 if show_tally then 541 TIO.Put_Line (LAT.LF & LAT.LF); 542 TIO.Put_Line ("The task is complete. Final tally:"); 543 TIO.Put_Line ("Initial queue size:" & bld_counter (total)'Img); 544 TIO.Put_Line (" packages built:" & bld_counter (success)'Img); 545 TIO.Put_Line (" ignored:" & bld_counter (ignored)'Img); 546 TIO.Put_Line (" skipped:" & bld_counter (skipped)'Img); 547 TIO.Put_Line (" failed:" & bld_counter (failure)'Img); 548 TIO.Put_Line (""); 549 TIO.Put_Line (CYC.log_duration (start_time, stop_time)); 550 TIO.Put_Line ("The build logs can be found at: " & 551 JT.USS (PM.configuration.dir_logs)); 552 end if; 553 end perform_bulk_run; 554 555 556 ------------------------------------------- 557 -- verify_desire_to_rebuild_repository -- 558 ------------------------------------------- 559 function verify_desire_to_rebuild_repository return Boolean 560 is 561 answer : Boolean; 562 YN : Character; 563 screen_present : constant Boolean := Unix.screen_attached; 564 begin 565 if not screen_present then 566 return False; 567 end if; 568 if SIG.graceful_shutdown_requested then 569 -- catch previous shutdown request 570 return False; 571 end if; 572 Unix.cone_of_silence (deploy => False); 573 TIO.Put ("Would you like to rebuild the local repository (Y/N)? "); 574 loop 575 TIO.Get_Immediate (YN); 576 case YN is 577 when 'Y' | 'y' => 578 answer := True; 579 exit; 580 when 'N' | 'n' => 581 answer := False; 582 exit; 583 when others => null; 584 end case; 585 end loop; 586 TIO.Put (YN & LAT.LF); 587 Unix.cone_of_silence (deploy => True); 588 return answer; 589 end verify_desire_to_rebuild_repository; 590 591 592 ----------------------------------------- 593 -- verify_desire_to_install_packages -- 594 ----------------------------------------- 595 function verify_desire_to_install_packages return Boolean is 596 answer : Boolean; 597 YN : Character; 598 begin 599 Unix.cone_of_silence (deploy => False); 600 TIO.Put ("Would you like to upgrade your system with the new packages now (Y/N)? "); 601 loop 602 TIO.Get_Immediate (YN); 603 case YN is 604 when 'Y' | 'y' => 605 answer := True; 606 exit; 607 when 'N' | 'n' => 608 answer := False; 609 exit; 610 when others => null; 611 end case; 612 end loop; 613 TIO.Put (YN & LAT.LF); 614 Unix.cone_of_silence (deploy => True); 615 return answer; 616 end verify_desire_to_install_packages; 617 618 619 ----------------------------- 620 -- fully_scan_ports_tree -- 621 ----------------------------- 622 function fully_scan_ports_tree return Boolean 623 is 624 goodresult : Boolean; 625 begin 626 PortScan.reset_ports_tree; 627 REP.initialize (testmode => False, num_cores => PortScan.cores_available); 628 REP.launch_slave (id => PortScan.scan_slave, opts => noprocs); 629 case software_framework is 630 when ports_collection => null; 631 when pkgsrc => 632 if not PLAT.standalone_pkg8_install (PortScan.scan_slave) then 633 TIO.Put_Line ("Full Tree Scan: Failed to bootstrap builder"); 634 end if; 635 end case; 636 goodresult := PortScan.scan_entire_ports_tree 637 (JT.USS (PM.configuration.dir_portsdir)); 638 REP.destroy_slave (id => PortScan.scan_slave, opts => noprocs); 639 REP.finalize; 640 if goodresult then 641 PortScan.set_build_priority; 642 return True; 643 else 644 if SIG.graceful_shutdown_requested then 645 TIO.Put_Line (shutreq); 646 else 647 TIO.Put_Line ("Failed to scan ports tree " & bailing); 648 end if; 649 CLI.Set_Exit_Status (1); 650 return False; 651 end if; 652 end fully_scan_ports_tree; 653 654 655 --------------------------------- 656 -- rebuild_local_respository -- 657 --------------------------------- 658 function rebuild_local_respository (remove_invalid_packages : Boolean) return Boolean 659 is 660 repo : constant String := JT.USS (PM.configuration.dir_repository); 661 main : constant String := JT.USS (PM.configuration.dir_packages); 662 packed_meta : constant String := main & "/meta.pkg"; 663 packed_digest : constant String := main & "/digests.pkg"; 664 packed_pkgsite : constant String := main & "/packagesite.pkg"; 665 bs_error : constant String := "Rebuild Repository: Failed to bootstrap builder"; 666 build_res : Boolean; 667 begin 668 if SIG.graceful_shutdown_requested then 669 -- In case it was previously requested 670 return False; 671 end if; 672 673 if remove_invalid_packages then 674 REP.initialize (testmode => False, 675 num_cores => PortScan.cores_available); 676 REP.launch_slave (id => PortScan.scan_slave, opts => noprocs); 677 case software_framework is 678 when ports_collection => null; 679 when pkgsrc => 680 if not PLAT.standalone_pkg8_install (PortScan.scan_slave) then 681 TIO.Put_Line (bs_error); 682 end if; 683 end case; 684 685 PKG.preclean_repository (repo); 686 687 REP.destroy_slave (id => PortScan.scan_slave, opts => noprocs); 688 REP.finalize; 689 if SIG.graceful_shutdown_requested then 690 TIO.Put_Line (shutreq); 691 return False; 692 end if; 693 end if; 694 695 TIO.Put ("Stand by, recursively scanning"); 696 if Natural (portlist.Length) = 1 then 697 TIO.Put (" 1 port"); 698 else 699 TIO.Put (portlist.Length'Img & " ports"); 700 end if; 701 TIO.Put_Line (" serially."); 702 PortScan.reset_ports_tree; 703 if scan_stack_of_single_ports (testmode => False) then 704 PKG.limited_sanity_check (repository => repo, 705 dry_run => False, 706 suppress_remote => True); 707 if SIG.graceful_shutdown_requested then 708 TIO.Put_Line (shutreq); 709 return False; 710 end if; 711 else 712 return False; 713 end if; 714 715 if AD.Exists (packed_meta) then 716 AD.Delete_File (packed_meta); 717 end if; 718 if AD.Exists (packed_digest) then 719 AD.Delete_File (packed_digest); 720 end if; 721 if AD.Exists (packed_pkgsite) then 722 AD.Delete_File (packed_pkgsite); 723 end if; 724 TIO.Put_Line ("Packages validated, rebuilding local repository."); 725 REP.initialize (testmode => False, num_cores => PortScan.cores_available); 726 REP.launch_slave (id => PortScan.scan_slave, opts => noprocs); 727 case software_framework is 728 when ports_collection => null; 729 when pkgsrc => 730 if not PLAT.standalone_pkg8_install (PortScan.scan_slave) then 731 TIO.Put_Line (bs_error); 732 733 end if; 734 end case; 735 if valid_signing_command then 736 build_res := REP.build_repository (id => PortScan.scan_slave, 737 sign_command => signing_command); 738 elsif acceptable_RSA_signing_support then 739 build_res := REP.build_repository (PortScan.scan_slave); 740 else 741 build_res := False; 742 end if; 743 REP.destroy_slave (id => PortScan.scan_slave, opts => noprocs); 744 REP.finalize; 745 if build_res then 746 TIO.Put_Line ("Local repository successfully rebuilt"); 747 return True; 748 else 749 TIO.Put_Line ("Failed to rebuild repository" & bailing); 750 return False; 751 end if; 752 end rebuild_local_respository; 753 754 755 ------------------ 756 -- valid_file -- 757 ------------------ 758 function valid_file (path : String) return Boolean 759 is 760 handle : TIO.File_Type; 761 good : Boolean; 762 total : Natural := 0; 763 begin 764 TIO.Open (File => handle, Mode => TIO.In_File, Name => path); 765 good := True; 766 while not TIO.End_Of_File (handle) loop 767 declare 768 line : constant String := JT.trim (TIO.Get_Line (handle)); 769 begin 770 if not JT.IsBlank (line) then 771 if input_origin_valid (candidate => line) then 772 plinsert (line, total); 773 total := total + 1; 774 else 775 suggest_flavor_for_bad_origin (candidate => line); 776 good := False; 777 exit; 778 end if; 779 end if; 780 end; 781 end loop; 782 TIO.Close (handle); 783 return (total > 0) and then good; 784 exception 785 when others => return False; 786 end valid_file; 787 788 789 ---------------- 790 -- plinsert -- 791 ---------------- 792 procedure plinsert (key : String; dummy : Natural) 793 is 794 key2 : JT.Text := JT.SUS (key); 795 ptid : constant PortScan.port_id := PortScan.port_id (dummy); 796 begin 797 if not portlist.Contains (key2) then 798 portlist.Insert (key2, ptid); 799 duplist.Insert (key2, ptid); 800 end if; 801 end plinsert; 802 803 804 --------------------- 805 -- start_logging -- 806 --------------------- 807 procedure start_logging (flavor : count_type) 808 is 809 logpath : constant String := JT.USS (PM.configuration.dir_logs) 810 & "/" & logname (flavor); 811 begin 812 if AD.Exists (logpath) then 813 AD.Delete_File (logpath); 814 end if; 815 TIO.Create (File => Flog (flavor), 816 Mode => TIO.Out_File, 817 Name => logpath); 818 if flavor = total then 819 TIO.Put_Line (Flog (flavor), "-=> Chronology of last build <=-"); 820 TIO.Put_Line (Flog (flavor), "Started: " & timestamp (start_time)); 821 TIO.Put_Line (Flog (flavor), "Ports to build:" & 822 PKG.original_queue_size'Img); 823 TIO.Put_Line (Flog (flavor), ""); 824 TIO.Put_Line (Flog (flavor), "Purging any ignored/broken ports " & 825 "first ..."); 826 TIO.Flush (Flog (flavor)); 827 end if; 828 exception 829 when others => 830 raise pilot_log 831 with "Failed to create or delete " & logpath & bailing; 832 end start_logging; 833 834 835 -------------------- 836 -- stop_logging -- 837 -------------------- 838 procedure stop_logging (flavor : count_type) is 839 begin 840 if flavor = total then 841 TIO.Put_Line (Flog (flavor), "Finished: " & timestamp (stop_time)); 842 TIO.Put_Line (Flog (flavor), CYC.log_duration (start => start_time, 843 stop => stop_time)); 844 TIO.Put_Line 845 (Flog (flavor), LAT.LF & 846 "---------------------------" & LAT.LF & 847 "-- Final Statistics" & LAT.LF & 848 "---------------------------" & LAT.LF & 849 " Initial queue size:" & bld_counter (total)'Img & LAT.LF & 850 " packages built:" & bld_counter (success)'Img & LAT.LF & 851 " ignored:" & bld_counter (ignored)'Img & LAT.LF & 852 " skipped:" & bld_counter (skipped)'Img & LAT.LF & 853 " failed:" & bld_counter (failure)'Img); 854 end if; 855 TIO.Close (Flog (flavor)); 856 end stop_logging; 857 858 859 ----------------------- 860 -- purge_distfiles -- 861 ----------------------- 862 procedure purge_distfiles 863 is 864 type disktype is mod 2**64; 865 procedure scan (plcursor : portkey_crate.Cursor); 866 procedure kill (plcursor : portkey_crate.Cursor); 867 procedure walk (name : String); 868 function display_kmg (number : disktype) return String; 869 abort_purge : Boolean := False; 870 bytes_purged : disktype := 0; 871 distfiles : portkey_crate.Map; 872 rmfiles : portkey_crate.Map; 873 874 procedure scan (plcursor : portkey_crate.Cursor) 875 is 876 origin : JT.Text := portkey_crate.Key (plcursor); 877 tracker : constant port_id := portkey_crate.Element (plcursor); 878 pndx : constant port_index := ports_keys.Element (origin); 879 distinfo : constant String := JT.USS (PM.configuration.dir_portsdir) & 880 "/" & JT.USS (origin) & "/distinfo"; 881 handle : TIO.File_Type; 882 bookend : Natural; 883 begin 884 TIO.Open (File => handle, Mode => TIO.In_File, Name => distinfo); 885 while not TIO.End_Of_File (handle) loop 886 declare 887 Line : String := TIO.Get_Line (handle); 888 begin 889 if Line (1 .. 4) = "SIZE" then 890 bookend := ASF.Index (Line, ")"); 891 declare 892 S : JT.Text := JT.SUS (Line (7 .. bookend - 1)); 893 begin 894 if not distfiles.Contains (S) then 895 distfiles.Insert (S, tracker); 896 end if; 897 exception 898 when failed : others => 899 TIO.Put_Line ("purge_distfiles::scan: " & JT.USS (S)); 900 TIO.Put_Line (EX.Exception_Information (failed)); 901 end; 902 end if; 903 end; 904 end loop; 905 TIO.Close (handle); 906 exception 907 when others => 908 if TIO.Is_Open (handle) then 909 TIO.Close (handle); 910 end if; 911 end scan; 912 913 procedure walk (name : String) 914 is 915 procedure walkdir (item : AD.Directory_Entry_Type); 916 procedure print (item : AD.Directory_Entry_Type); 917 uniqid : port_id := 0; 918 leftindent : Natural := 919 JT.SU.Length (PM.configuration.dir_distfiles) + 2; 920 921 procedure walkdir (item : AD.Directory_Entry_Type) is 922 begin 923 if AD.Simple_Name (item) /= "." and then 924 AD.Simple_Name (item) /= ".." 925 then 926 walk (AD.Full_Name (item)); 927 end if; 928 exception 929 when AD.Name_Error => 930 abort_purge := True; 931 TIO.Put_Line ("walkdir: " & name & " directory does not exist"); 932 end walkdir; 933 procedure print (item : AD.Directory_Entry_Type) 934 is 935 FN : constant String := AD.Full_Name (item); 936 tball : JT.Text := JT.SUS (FN (leftindent .. FN'Last)); 937 begin 938 if not distfiles.Contains (tball) then 939 if not rmfiles.Contains (tball) then 940 uniqid := uniqid + 1; 941 rmfiles.Insert (Key => tball, New_Item => uniqid); 942 bytes_purged := bytes_purged + disktype (AD.Size (FN)); 943 end if; 944 end if; 945 end print; 946 begin 947 AD.Search (name, "*", (AD.Ordinary_File => True, others => False), 948 print'Access); 949 AD.Search (name, "", (AD.Directory => True, others => False), 950 walkdir'Access); 951 exception 952 when AD.Name_Error => 953 abort_purge := True; 954 TIO.Put_Line ("The " & name & " directory does not exist"); 955 when AD.Use_Error => 956 abort_purge := True; 957 TIO.Put_Line ("Searching " & name & " directory is not supported"); 958 when failed : others => 959 abort_purge := True; 960 TIO.Put_Line ("purge_distfiles: Unknown error - directory search"); 961 TIO.Put_Line (EX.Exception_Information (failed)); 962 end walk; 963 964 function display_kmg (number : disktype) return String 965 is 966 type kmgtype is delta 0.01 digits 6; 967 kilo : constant disktype := 1024; 968 mega : constant disktype := kilo * kilo; 969 giga : constant disktype := kilo * mega; 970 XXX : kmgtype; 971 begin 972 if number > giga then 973 XXX := kmgtype (number / giga); 974 return XXX'Img & " gigabytes"; 975 elsif number > mega then 976 XXX := kmgtype (number / mega); 977 return XXX'Img & " megabytes"; 978 else 979 XXX := kmgtype (number / kilo); 980 return XXX'Img & " kilobytes"; 981 end if; 982 end display_kmg; 983 984 procedure kill (plcursor : portkey_crate.Cursor) 985 is 986 tarball : String := JT.USS (portkey_crate.Key (plcursor)); 987 path : JT.Text := PM.configuration.dir_distfiles; 988 begin 989 JT.SU.Append (path, "/" & tarball); 990 TIO.Put_Line ("Deleting " & tarball); 991 AD.Delete_File (JT.USS (path)); 992 end kill; 993 994 begin 995 read_flavor_index; 996 TIO.Put ("Scanning the distinfo file of every port in the tree ... "); 997 ports_keys.Iterate (Process => scan'Access); 998 TIO.Put_Line ("done"); 999 walk (name => JT.USS (PM.configuration.dir_distfiles)); 1000 if abort_purge then 1001 TIO.Put_Line ("Distfile purge operation aborted."); 1002 else 1003 rmfiles.Iterate (kill'Access); 1004 TIO.Put_Line ("Recovered" & display_kmg (bytes_purged)); 1005 end if; 1006 end purge_distfiles; 1007 1008 1009 ------------------------------------------ 1010 -- write_pkg_repos_configuration_file -- 1011 ------------------------------------------ 1012 function write_pkg_repos_configuration_file return Boolean 1013 is 1014 repdir : constant String := get_repos_dir; 1015 target : constant String := repdir & "/00_synth.conf"; 1016 pkgdir : constant String := JT.USS (PM.configuration.dir_packages); 1017 pubkey : constant String := PM.synth_confdir & "/" & 1018 JT.USS (PM.configuration.profile) & "-public.key"; 1019 keydir : constant String := PM.synth_confdir & "/keys"; 1020 tstdir : constant String := keydir & "/trusted"; 1021 autgen : constant String := "# Automatically generated." & LAT.LF; 1022 fpfile : constant String := tstdir & "/fingerprint." & 1023 JT.USS (PM.configuration.profile); 1024 handle : TIO.File_Type; 1025 vscmd : Boolean := False; 1026 begin 1027 if AD.Exists (target) then 1028 AD.Delete_File (target); 1029 elsif not AD.Exists (repdir) then 1030 AD.Create_Path (repdir); 1031 end if; 1032 TIO.Create (File => handle, Mode => TIO.Out_File, Name => target); 1033 TIO.Put_Line (handle, autgen); 1034 TIO.Put_Line (handle, "Synth: {"); 1035 TIO.Put_Line (handle, " url : file://" & pkgdir & ","); 1036 TIO.Put_Line (handle, " priority : 0,"); 1037 TIO.Put_Line (handle, " enabled : yes,"); 1038 if valid_signing_command then 1039 vscmd := True; 1040 TIO.Put_Line (handle, " signature_type : FINGERPRINTS,"); 1041 TIO.Put_Line (handle, " fingerprints : " & keydir); 1042 elsif set_synth_conf_with_RSA then 1043 TIO.Put_Line (handle, " signature_type : PUBKEY,"); 1044 TIO.Put_Line (handle, " pubkey : " & pubkey); 1045 end if; 1046 TIO.Put_Line (handle, "}"); 1047 TIO.Close (handle); 1048 if vscmd then 1049 if AD.Exists (fpfile) then 1050 AD.Delete_File (fpfile); 1051 elsif not AD.Exists (tstdir) then 1052 AD.Create_Path (tstdir); 1053 end if; 1054 TIO.Create (File => handle, Mode => TIO.Out_File, Name => fpfile); 1055 TIO.Put_Line (handle, autgen); 1056 TIO.Put_Line (handle, "function : sha256"); 1057 TIO.Put_Line (handle, "fingerprint : " & profile_fingerprint); 1058 TIO.Close (handle); 1059 end if; 1060 return True; 1061 exception 1062 when others => 1063 TIO.Put_Line ("Error: failed to create " & target); 1064 if TIO.Is_Open (handle) then 1065 TIO.Close (handle); 1066 end if; 1067 return False; 1068 end write_pkg_repos_configuration_file; 1069 1070 1071 --------------------------------- 1072 -- upgrade_system_everything -- 1073 --------------------------------- 1074 procedure upgrade_system_everything (skip_installation : Boolean := False; 1075 dry_run : Boolean := False) 1076 is 1077 command : constant String := host_pkg8 & 1078 " upgrade --yes --repository Synth"; 1079 query : constant String := host_pkg8 & " query -a %o:%n"; 1080 sorry : constant String := "Unfortunately, the system upgrade failed."; 1081 begin 1082 if not prescanned then 1083 read_flavor_index; 1084 end if; 1085 portlist.Clear; 1086 TIO.Put_Line ("Querying system about current package installations."); 1087 begin 1088 declare 1089 comres : constant String := JT.USS (CYC.generic_system_command (query)); 1090 markers : JT.Line_Markers; 1091 uniqid : Natural := 0; 1092 begin 1093 JT.initialize_markers (comres, markers); 1094 loop 1095 exit when not JT.next_line_present (comres, markers); 1096 declare 1097 line : constant String := JT.extract_line (comres, markers); 1098 origin : constant String := JT.part_1 (line, ":"); 1099 pkgbase : constant String := JT.part_2 (line, ":"); 1100 flvquery : constant String := host_pkg8 & " query %At:%Av " & pkgbase; 1101 errprefix : constant String := "Installed package ignored, "; 1102 origintxt : JT.Text := JT.SUS (origin); 1103 target_id : port_id := port_match_failed; 1104 maxprobe : port_index := port_index (so_serial.Length) - 1; 1105 found_it : Boolean := False; 1106 flvresult : JT.Text; 1107 begin 1108 -- This approach isn't the greatest, but we're missing information. 1109 -- At this port, all_ports array is not populated, so we can't compare the 1110 -- package names to determine flavors. So what we do is search so_serial 1111 -- for the origin. If it exists, the port has no flavors and we take the 1112 -- target id. Otherwise, we have to query the system for the installed 1113 -- flavor. It it fail on pre-flavor installations, though. Once all packages 1114 -- are completely replaced, this approach should work fine. 1115 1116 if so_porthash.Contains (origintxt) then 1117 if so_serial.Contains (origintxt) then 1118 target_id := so_porthash.Element (origintxt); 1119 found_it := True; 1120 else 1121 flvresult := CYC.generic_system_command (flvquery); 1122 declare 1123 contents : constant String := JT.USS (flvresult); 1124 markers : JT.Line_Markers; 1125 begin 1126 JT.initialize_markers (contents, markers); 1127 if JT.next_line_with_content_present (contents, "flavor:", markers) then 1128 declare 1129 line : constant String := JT.extract_line (contents, markers); 1130 flvorigin : JT.Text; 1131 begin 1132 flvorigin := JT.SUS (origin & "@" & JT.part_2 (line, ":")); 1133 if so_serial.Contains (flvorigin) then 1134 target_id := so_serial.Find_Index (flvorigin); 1135 found_it := True; 1136 end if; 1137 end; 1138 end if; 1139 end; 1140 end if; 1141 if found_it then 1142 uniqid := uniqid + 1; 1143 plinsert (get_catport (all_ports (target_id)), uniqid); 1144 else 1145 TIO.Put_Line (errprefix & origin & " package unmatched"); 1146 end if; 1147 else 1148 TIO.Put_Line (errprefix & "missing from ports: " & origin); 1149 end if; 1150 end; 1151 end loop; 1152 end; 1153 exception 1154 when others => 1155 TIO.Put_Line (sorry & " (system query)"); 1156 return; 1157 end; 1158 TIO.Put_Line ("Stand by, comparing installed packages against the ports tree."); 1159 if prerequisites_available and then 1160 scan_stack_of_single_ports (testmode => False) and then 1161 sanity_check_then_prefail (delete_first => False, dry_run => dry_run) 1162 then 1163 if dry_run then 1164 display_results_of_dry_run; 1165 return; 1166 else 1167 perform_bulk_run (testmode => False); 1168 end if; 1169 else 1170 if not SIG.graceful_shutdown_requested then 1171 TIO.Put_Line (sorry); 1172 end if; 1173 return; 1174 end if; 1175 if SIG.graceful_shutdown_requested then 1176 return; 1177 end if; 1178 if rebuild_local_respository (remove_invalid_packages => True) then 1179 if not skip_installation then 1180 if not Unix.external_command (command) then 1181 TIO.Put_Line (sorry); 1182 end if; 1183 end if; 1184 end if; 1185 end upgrade_system_everything; 1186 1187 1188 ------------------------------ 1189 -- upgrade_system_exactly -- 1190 ------------------------------ 1191 procedure upgrade_system_exactly 1192 is 1193 procedure build_train (plcursor : portkey_crate.Cursor); 1194 base_command : constant String := host_pkg8 & 1195 " install --yes --repository Synth"; 1196 caboose : JT.Text; 1197 1198 procedure build_train (plcursor : portkey_crate.Cursor) 1199 is 1200 full_origin : JT.Text renames portkey_crate.Key (plcursor); 1201 pix : constant port_index := ports_keys.Element (full_origin); 1202 pkgfile : constant String := JT.USS (all_ports (pix).package_name); 1203 begin 1204 JT.SU.Append (caboose, " " & JT.head (pkgfile, ".")); 1205 end build_train; 1206 begin 1207 duplist.Iterate (Process => build_train'Access); 1208 declare 1209 command : constant String := base_command & JT.USS (caboose); 1210 begin 1211 if not Unix.external_command (command) then 1212 TIO.Put_Line ("Unfortunately, the system upgraded failed."); 1213 end if; 1214 end; 1215 end upgrade_system_exactly; 1216 1217 1218 ------------------------------- 1219 -- insufficient_privileges -- 1220 ------------------------------- 1221 function insufficient_privileges return Boolean 1222 is 1223 command : constant String := "/usr/bin/id -u"; 1224 result : JT.Text := CYC.generic_system_command (command); 1225 topline : JT.Text; 1226 begin 1227 JT.nextline (lineblock => result, firstline => topline); 1228 declare 1229 resint : constant Integer := Integer'Value (JT.USS (topline)); 1230 begin 1231 return (resint /= 0); 1232 end; 1233 end insufficient_privileges; 1234 1235 1236 --------------- 1237 -- head_n1 -- 1238 --------------- 1239 function head_n1 (filename : String) return String 1240 is 1241 handle : TIO.File_Type; 1242 begin 1243 TIO.Open (File => handle, Mode => TIO.In_File, Name => filename); 1244 if TIO.End_Of_File (handle) then 1245 TIO.Close (handle); 1246 return ""; 1247 end if; 1248 1249 declare 1250 line : constant String := TIO.Get_Line (handle); 1251 begin 1252 TIO.Close (handle); 1253 return line; 1254 end; 1255 end head_n1; 1256 1257 1258 ----------------------- 1259 -- already_running -- 1260 ----------------------- 1261 function already_running return Boolean 1262 is 1263 pid : Integer; 1264 comres : JT.Text; 1265 begin 1266 if AD.Exists (pidfile) then 1267 declare 1268 textpid : constant String := head_n1 (pidfile); 1269 command : constant String := "/bin/ps -p " & textpid; 1270 begin 1271 -- test if valid by converting it (exception if fails) 1272 pid := Integer'Value (textpid); 1273 1274 -- exception raised by line below if pid not found. 1275 comres := CYC.generic_system_command (command); 1276 if JT.contains (comres, "synth") then 1277 return True; 1278 else 1279 -- pidfile is obsolete, remove it. 1280 AD.Delete_File (pidfile); 1281 return False; 1282 end if; 1283 exception 1284 when others => 1285 -- pidfile contains garbage, remove it 1286 AD.Delete_File (pidfile); 1287 return False; 1288 end; 1289 end if; 1290 return False; 1291 end already_running; 1292 1293 1294 ----------------------- 1295 -- destroy_pidfile -- 1296 ----------------------- 1297 procedure destroy_pidfile is 1298 begin 1299 if AD.Exists (pidfile) then 1300 AD.Delete_File (pidfile); 1301 end if; 1302 exception 1303 when others => null; 1304 end destroy_pidfile; 1305 1306 1307 ---------------------- 1308 -- create_pidfile -- 1309 ---------------------- 1310 procedure create_pidfile 1311 is 1312 pidtext : constant String := JT.int2str (Get_PID); 1313 handle : TIO.File_Type; 1314 begin 1315 TIO.Create (File => handle, Mode => TIO.Out_File, Name => pidfile); 1316 TIO.Put_Line (handle, pidtext); 1317 TIO.Close (handle); 1318 end create_pidfile; 1319 1320 1321 ------------------------------ 1322 -- set_replicant_platform -- 1323 ------------------------------ 1324 procedure set_replicant_platform is 1325 begin 1326 REP.set_platform; 1327 end set_replicant_platform; 1328 1329 1330 ------------------------------------ 1331 -- previous_run_mounts_detected -- 1332 ------------------------------------ 1333 function previous_run_mounts_detected return Boolean is 1334 begin 1335 return REP.synth_mounts_exist; 1336 end previous_run_mounts_detected; 1337 1338 1339 ------------------------------------- 1340 -- previous_realfs_work_detected -- 1341 ------------------------------------- 1342 function previous_realfs_work_detected return Boolean is 1343 begin 1344 return REP.disk_workareas_exist; 1345 end previous_realfs_work_detected; 1346 1347 1348 --------------------------------------- 1349 -- old_mounts_successfully_removed -- 1350 --------------------------------------- 1351 function old_mounts_successfully_removed return Boolean is 1352 begin 1353 if REP.clear_existing_mounts then 1354 TIO.Put_Line ("Dismounting successful!"); 1355 return True; 1356 end if; 1357 TIO.Put_Line ("The attempt failed. " & 1358 "Check for stuck or ongoing processes and kill them."); 1359 TIO.Put_Line ("After that, try running Synth again or just manually " & 1360 "unmount everything"); 1361 TIO.Put_Line ("still attached to " & 1362 JT.USS (PM.configuration.dir_buildbase)); 1363 return False; 1364 end old_mounts_successfully_removed; 1365 1366 1367 -------------------------------------------- 1368 -- old_realfs_work_successfully_removed -- 1369 -------------------------------------------- 1370 function old_realfs_work_successfully_removed return Boolean is 1371 begin 1372 if REP.clear_existing_workareas then 1373 TIO.Put_Line ("Directory removal successful!"); 1374 return True; 1375 end if; 1376 TIO.Put_Line ("The attempt to remove the work directories located at "); 1377 TIO.Put_Line (JT.USS (PM.configuration.dir_buildbase) & "failed."); 1378 TIO.Put_Line ("Please remove them manually before continuing"); 1379 return False; 1380 end old_realfs_work_successfully_removed; 1381 1382 1383 ------------------------- 1384 -- synthexec_missing -- 1385 ------------------------- 1386 function synthexec_missing return Boolean 1387 is 1388 synthexec : constant String := host_localbase & "/libexec/synthexec"; 1389 begin 1390 if AD.Exists (synthexec) then 1391 return False; 1392 end if; 1393 TIO.Put_Line (synthexec & " missing!" & bailing); 1394 return True; 1395 end synthexec_missing; 1396 1397 1398 ---------------------------------- 1399 -- display_results_of_dry_run -- 1400 ---------------------------------- 1401 procedure display_results_of_dry_run 1402 is 1403 procedure print (cursor : ranking_crate.Cursor); 1404 listlog : TIO.File_Type; 1405 filename : constant String := "/var/synth/synth_status_results.txt"; 1406 max_lots : constant scanners := get_max_lots; 1407 elap_raw : constant String := CYC.log_duration (start => scan_start, 1408 stop => scan_stop); 1409 elapsed : constant String := elap_raw (elap_raw'First + 10 .. 1410 elap_raw'Last); 1411 goodlog : Boolean; 1412 1413 procedure print (cursor : ranking_crate.Cursor) 1414 is 1415 id : port_id := ranking_crate.Element (cursor).ap_index; 1416 kind : verdiff; 1417 diff : constant String := version_difference (id, kind); 1418 origin : constant String := get_catport (all_ports (id)); 1419 begin 1420 case kind is 1421 when newbuild => TIO.Put_Line (" N => " & origin); 1422 when rebuild => TIO.Put_Line (" R => " & origin); 1423 when change => TIO.Put_Line (" U => " & origin & diff); 1424 end case; 1425 if goodlog then 1426 TIO.Put_Line (listlog, origin & diff); 1427 end if; 1428 end print; 1429 begin 1430 begin 1431 -- Try to defend malicious symlink: https://en.wikipedia.org/wiki/Symlink_race 1432 if AD.Exists (filename) then 1433 AD.Delete_File (filename); 1434 end if; 1435 TIO.Create (File => listlog, Mode => TIO.Out_File, Name => filename); 1436 goodlog := True; 1437 exception 1438 when others => goodlog := False; 1439 end; 1440 TIO.Put_Line ("These are the ports that would be built ([N]ew, " & 1441 "[R]ebuild, [U]pgrade):"); 1442 rank_queue.Iterate (print'Access); 1443 TIO.Put_Line ("Total packages that would be built:" & 1444 rank_queue.Length'Img); 1445 if goodlog then 1446 TIO.Put_Line 1447 (listlog, LAT.LF & 1448 "------------------------------" & LAT.LF & 1449 "-- Statistics" & LAT.LF & 1450 "------------------------------" & LAT.LF & 1451 " Ports scanned :" & last_port'Img & LAT.LF & 1452 " Elapsed time : " & elapsed & LAT.LF & 1453 " Parallelism :" & max_lots'Img & " scanners" & LAT.LF & 1454 " ncpu :" & number_cores'Img); 1455 TIO.Close (listlog); 1456 TIO.Put_Line ("The complete build list can also be found at:" 1457 & LAT.LF & filename); 1458 end if; 1459 end display_results_of_dry_run; 1460 1461 1462 --------------------- 1463 -- get_repos_dir -- 1464 --------------------- 1465 function get_repos_dir return String 1466 is 1467 command : String := host_pkg8 & " config repos_dir"; 1468 content : JT.Text; 1469 topline : JT.Text; 1470 crlen1 : Natural; 1471 crlen2 : Natural; 1472 begin 1473 content := CYC.generic_system_command (command); 1474 crlen1 := JT.SU.Length (content); 1475 loop 1476 JT.nextline (lineblock => content, firstline => topline); 1477 crlen2 := JT.SU.Length (content); 1478 exit when crlen1 = crlen2; 1479 crlen1 := crlen2; 1480 if not JT.equivalent (topline, "/etc/pkg/") then 1481 return JT.USS (topline); 1482 end if; 1483 end loop; 1484 -- fallback, use default 1485 return host_localbase & "/etc/pkg/repos"; 1486 end get_repos_dir; 1487 1488 1489 ------------------------------------ 1490 -- interact_with_single_builder -- 1491 ------------------------------------ 1492 function interact_with_single_builder return Boolean 1493 is 1494 EA_defined : constant Boolean := Unix.env_variable_defined (brkname); 1495 begin 1496 if Natural (portlist.Length) /= 1 then 1497 return False; 1498 end if; 1499 if not EA_defined then 1500 return False; 1501 end if; 1502 return CYC.valid_test_phase (Unix.env_variable_value (brkname)); 1503 end interact_with_single_builder; 1504 1505 1506 ---------------------------------------------- 1507 -- bulk_run_then_interact_with_final_port -- 1508 ---------------------------------------------- 1509 procedure bulk_run_then_interact_with_final_port 1510 is 1511 uscatport : JT.Text := portkey_crate.Key (Position => portlist.First); 1512 brkphase : constant String := Unix.env_variable_value (brkname); 1513 buildres : Boolean; 1514 ptid : port_id; 1515 begin 1516 if ports_keys.Contains (Key => uscatport) then 1517 ptid := ports_keys.Element (Key => uscatport); 1518 end if; 1519 1520 OPS.unlist_port (ptid); 1521 perform_bulk_run (testmode => True); 1522 if SIG.graceful_shutdown_requested then 1523 return; 1524 end if; 1525 if bld_counter (ignored) > 0 or else 1526 bld_counter (skipped) > 0 or else 1527 bld_counter (failure) > 0 1528 then 1529 TIO.Put_Line ("It appears a prerequisite failed, so the interactive" & 1530 " build of"); 1531 TIO.Put_Line (JT.USS (uscatport) & " has been cancelled."); 1532 return; 1533 end if; 1534 TIO.Put_Line ("Starting interactive build of " & JT.USS (uscatport)); 1535 TIO.Put_Line ("Stand by, building up to the point requested ..."); 1536 1537 REP.initialize (testmode => True, num_cores => PortScan.cores_available); 1538 CYC.initialize (test_mode => True, jail_env => REP.jail_environment); 1539 REP.launch_slave (id => PortScan.scan_slave, opts => noprocs); 1540 1541 Unix.cone_of_silence (deploy => False); 1542 case software_framework is 1543 when ports_collection => 1544 buildres := FPC.build_package (id => PortScan.scan_slave, 1545 sequence_id => ptid, 1546 interactive => True, 1547 interphase => brkphase); 1548 when pkgsrc => 1549 if PLAT.standalone_pkg8_install (PortScan.scan_slave) then 1550 buildres := NPS.build_package (id => PortScan.scan_slave, 1551 sequence_id => ptid, 1552 interactive => True, 1553 interphase => brkphase); 1554 end if; 1555 end case; 1556 1557 REP.destroy_slave (id => PortScan.scan_slave, opts => noprocs); 1558 REP.finalize; 1559 end bulk_run_then_interact_with_final_port; 1560 1561 1562 -------------------------- 1563 -- synth_launch_clash -- 1564 -------------------------- 1565 function synth_launch_clash return Boolean 1566 is 1567 function get_usrlocal return String; 1568 function get_usrlocal return String is 1569 begin 1570 if JT.equivalent (PM.configuration.dir_system, "/") then 1571 return host_localbase; 1572 end if; 1573 return JT.USS (PM.configuration.dir_system) & host_localbase; 1574 end get_usrlocal; 1575 1576 cwd : constant String := AD.Current_Directory; 1577 usrlocal : constant String := get_usrlocal; 1578 portsdir : constant String := JT.USS (PM.configuration.dir_portsdir); 1579 ullen : constant Natural := usrlocal'Length; 1580 pdlen : constant Natural := portsdir'Length; 1581 begin 1582 if cwd = usrlocal or else cwd = portsdir then 1583 return True; 1584 end if; 1585 if cwd'Length > ullen and then 1586 cwd (1 .. ullen + 1) = usrlocal & "/" 1587 then 1588 return True; 1589 end if; 1590 if cwd'Length > pdlen and then 1591 cwd (1 .. pdlen + 1) = portsdir & "/" 1592 then 1593 return True; 1594 end if; 1595 return False; 1596 exception 1597 when others => return True; 1598 end synth_launch_clash; 1599 1600 1601 -------------------------- 1602 -- version_difference -- 1603 -------------------------- 1604 function version_difference (id : port_id; kind : out verdiff) return String 1605 is 1606 dir_pkg : constant String := JT.USS (PM.configuration.dir_repository); 1607 current : constant String := JT.USS (all_ports (id).package_name); 1608 version : constant String := JT.USS (all_ports (id).port_version); 1609 begin 1610 if AD.Exists (dir_pkg & "/" & current) then 1611 kind := rebuild; 1612 return " (rebuild " & version & ")"; 1613 end if; 1614 declare 1615 pkgbase : constant String := JT.head (current, "-"); 1616 pattern : constant String := pkgbase & "-*.pkg"; 1617 upgrade : JT.Text; 1618 1619 pkg_search : AD.Search_Type; 1620 dirent : AD.Directory_Entry_Type; 1621 begin 1622 AD.Start_Search (Search => pkg_search, 1623 Directory => dir_pkg, 1624 Filter => (AD.Ordinary_File => True, others => False), 1625 Pattern => pattern); 1626 while AD.More_Entries (Search => pkg_search) loop 1627 AD.Get_Next_Entry (Search => pkg_search, Directory_Entry => dirent); 1628 declare 1629 sname : String := AD.Simple_Name (dirent); 1630 testbase : String := PKG.query_pkgbase (dir_pkg & "/" & sname); 1631 testver : String := JT.tail (JT.head (sname, "."), "-"); 1632 begin 1633 if testbase = pkgbase then 1634 upgrade := JT.SUS (" (" & testver & " => " & version & ")"); 1635 end if; 1636 end; 1637 end loop; 1638 if not JT.IsBlank (upgrade) then 1639 kind := change; 1640 return JT.USS (upgrade); 1641 end if; 1642 end; 1643 kind := newbuild; 1644 return " (new " & version & ")"; 1645 end version_difference; 1646 1647 1648 ------------------------ 1649 -- file_permissions -- 1650 ------------------------ 1651 function file_permissions (full_path : String) return String 1652 is 1653 command : constant String := "/usr/bin/stat -f %Lp " & full_path; 1654 content : JT.Text; 1655 topline : JT.Text; 1656 status : Integer; 1657 begin 1658 content := Unix.piped_command (command, status); 1659 if status /= 0 then 1660 return "000"; 1661 end if; 1662 JT.nextline (lineblock => content, firstline => topline); 1663 return JT.USS (topline); 1664 end file_permissions; 1665 1666 1667 -------------------------------------- 1668 -- acceptable_RSA_signing_support -- 1669 -------------------------------------- 1670 function acceptable_RSA_signing_support return Boolean 1671 is 1672 file_prefix : constant String := PM.synth_confdir & "/" & 1673 JT.USS (PM.configuration.profile) & "-"; 1674 key_private : constant String := file_prefix & "private.key"; 1675 key_public : constant String := file_prefix & "public.key"; 1676 found_private : constant Boolean := AD.Exists (key_private); 1677 found_public : constant Boolean := AD.Exists (key_public); 1678 sorry : constant String := "The generated repository will not " & 1679 "be signed due to the misconfiguration."; 1680 repo_key : constant String := JT.USS (PM.configuration.dir_buildbase) 1681 & ss_base & "/etc/repo.key"; 1682 begin 1683 if not found_private and then not found_public then 1684 return True; 1685 end if; 1686 if found_public and then not found_private then 1687 TIO.Put_Line ("A public RSA key file has been found without a " & 1688 "corresponding private key file."); 1689 TIO.Put_Line (sorry); 1690 return True; 1691 end if; 1692 if found_private and then not found_public then 1693 TIO.Put_Line ("A private RSA key file has been found without a " & 1694 "corresponding public key file."); 1695 TIO.Put_Line (sorry); 1696 return True; 1697 end if; 1698 declare 1699 mode : constant String := file_permissions (key_private); 1700 begin 1701 if mode /= "400" then 1702 TIO.Put_Line ("The private RSA key file has insecure file " & 1703 "permissions (" & mode & ")"); 1704 TIO.Put_Line ("Please change the mode of " & key_private & 1705 " to 400 before continuing."); 1706 return False; 1707 end if; 1708 end; 1709 declare 1710 begin 1711 AD.Copy_File (Source_Name => key_private, 1712 Target_Name => repo_key); 1713 return True; 1714 exception 1715 when failed : others => 1716 TIO.Put_Line ("Failed to copy private RSA key to builder."); 1717 TIO.Put_Line (EX.Exception_Information (failed)); 1718 return False; 1719 end; 1720 end acceptable_RSA_signing_support; 1721 1722 1723 ---------------------------------- 1724 -- acceptable_signing_command -- 1725 ---------------------------------- 1726 function valid_signing_command return Boolean 1727 is 1728 file_prefix : constant String := PM.synth_confdir & "/" & 1729 JT.USS (PM.configuration.profile) & "-"; 1730 fingerprint : constant String := file_prefix & "fingerprint"; 1731 ext_command : constant String := file_prefix & "signing_command"; 1732 found_finger : constant Boolean := AD.Exists (fingerprint); 1733 found_command : constant Boolean := AD.Exists (ext_command); 1734 sorry : constant String := "The generated repository will not " & 1735 "be externally signed due to the misconfiguration."; 1736 begin 1737 if found_finger and then found_command then 1738 if JT.IsBlank (one_line_file_contents (fingerprint)) or else 1739 JT.IsBlank (one_line_file_contents (ext_command)) 1740 then 1741 TIO.Put_Line ("At least one of the profile signing command " & 1742 "files is blank"); 1743 TIO.Put_Line (sorry); 1744 return False; 1745 end if; 1746 return True; 1747 end if; 1748 1749 if found_finger then 1750 TIO.Put_Line ("The profile fingerprint was found but not the " & 1751 "signing command"); 1752 TIO.Put_Line (sorry); 1753 elsif found_command then 1754 TIO.Put_Line ("The profile signing command was found but not " & 1755 "the fingerprint"); 1756 TIO.Put_Line (sorry); 1757 end if; 1758 1759 return False; 1760 end valid_signing_command; 1761 1762 1763 ----------------------- 1764 -- signing_command -- 1765 ----------------------- 1766 function signing_command return String 1767 is 1768 filename : constant String := PM.synth_confdir & "/" & 1769 JT.USS (PM.configuration.profile) & "-signing_command"; 1770 begin 1771 return one_line_file_contents (filename); 1772 end signing_command; 1773 1774 1775 --------------------------- 1776 -- profile_fingerprint -- 1777 --------------------------- 1778 function profile_fingerprint return String 1779 is 1780 filename : constant String := PM.synth_confdir & "/" & 1781 JT.USS (PM.configuration.profile) & "-fingerprint"; 1782 begin 1783 return one_line_file_contents (filename); 1784 end profile_fingerprint; 1785 1786 1787 ------------------------------- 1788 -- set_synth_conf_with_RSA -- 1789 ------------------------------- 1790 function set_synth_conf_with_RSA return Boolean 1791 is 1792 file_prefix : constant String := PM.synth_confdir & "/" & 1793 JT.USS (PM.configuration.profile) & "-"; 1794 key_private : constant String := file_prefix & "private.key"; 1795 key_public : constant String := file_prefix & "public.key"; 1796 found_private : constant Boolean := AD.Exists (key_private); 1797 found_public : constant Boolean := AD.Exists (key_public); 1798 begin 1799 return 1800 found_public and then 1801 found_private and then 1802 file_permissions (key_private) = "400"; 1803 end set_synth_conf_with_RSA; 1804 1805 1806 ------------------------------ 1807 -- one_line_file_contents -- 1808 ------------------------------ 1809 function one_line_file_contents (filename : String) return String 1810 is 1811 target_file : TIO.File_Type; 1812 contents : JT.Text := JT.blank; 1813 begin 1814 TIO.Open (File => target_file, Mode => TIO.In_File, Name => filename); 1815 if not TIO.End_Of_File (target_file) then 1816 contents := JT.SUS (TIO.Get_Line (target_file)); 1817 end if; 1818 TIO.Close (target_file); 1819 return JT.USS (contents); 1820 end one_line_file_contents; 1821 1822 1823 ------------------------- 1824 -- valid_system_root -- 1825 ------------------------- 1826 function valid_system_root return Boolean is 1827 begin 1828 if REP.boot_modules_directory_missing then 1829 TIO.Put_Line ("The /boot directory is optional, but when it exists, " & 1830 "the /boot/modules directory must also exist."); 1831 TIO.Put ("Please create the "); 1832 if not JT.equivalent (PM.configuration.dir_system, "/") then 1833 TIO.Put (JT.USS (PM.configuration.dir_system)); 1834 end if; 1835 TIO.Put_Line ("/boot/modules directory and retry."); 1836 return False; 1837 end if; 1838 return True; 1839 end valid_system_root; 1840 1841 1842 ------------------------------------------ 1843 -- host_pkg8_conservative_upgrade_set -- 1844 ------------------------------------------ 1845 function host_pkg8_conservative_upgrade_set return Boolean 1846 is 1847 command : constant String := host_pkg8 & " config CONSERVATIVE_UPGRADE"; 1848 content : JT.Text; 1849 topline : JT.Text; 1850 begin 1851 content := CYC.generic_system_command (command); 1852 JT.nextline (lineblock => content, firstline => topline); 1853 return JT.equivalent (topline, "yes"); 1854 end host_pkg8_conservative_upgrade_set; 1855 1856 1857 ----------------------------------- 1858 -- TERM_defined_in_environment -- 1859 ----------------------------------- 1860 function TERM_defined_in_environment return Boolean 1861 is 1862 defined : constant Boolean := Unix.env_variable_defined ("TERM"); 1863 begin 1864 if not defined then 1865 TIO.Put_Line ("Please define TERM in environment first and retry."); 1866 TIO.Put_Line ("If synth is being called in a cron job, define TERM=" & dumterm & "."); 1867 end if; 1868 return defined; 1869 end TERM_defined_in_environment; 1870 1871 1872 ------------------------- 1873 -- ensure_port_index -- 1874 ------------------------- 1875 function ensure_port_index return Boolean 1876 is 1877 index_file : constant String := "/var/cache/synth/" & 1878 JT.USS (PM.configuration.profile) & "-index"; 1879 needs_gen : Boolean := True; 1880 tree_newer : Boolean; 1881 valid_check : Boolean; 1882 answer : Character; 1883 portsdir : constant String := JT.USS (PM.configuration.dir_portsdir); 1884 command : constant String := "/usr/bin/touch " & index_file; 1885 stars : String (1 .. 67) := (others => '*'); 1886 msg1 : String := " The ports tree has at least one file newer than the flavor index."; 1887 msg2 : String := " However, port directories perfectly match. Should the index be"; 1888 msg3 : String := " regenerated? (Y/N) "; 1889 begin 1890 if AD.Exists (index_file) then 1891 tree_newer := index_out_of_date (index_file, valid_check); 1892 if not valid_check then 1893 return False; 1894 end if; 1895 if tree_newer then 1896 -- TERM guaranteed to already be defined (see TERM_defined_in_environment) 1897 if Unix.env_variable_value ("TERM") /= dumterm then 1898 if tree_directories_match (index_file, portsdir) then 1899 TIO.Put_Line (stars); 1900 TIO.Put_Line (msg1); 1901 TIO.Put_Line (msg2); 1902 TIO.Put (msg3); 1903 loop 1904 Ada.Text_IO.Get_Immediate (answer); 1905 case answer is 1906 when 'Y' | 'y' => 1907 TIO.Put_Line ("yes"); 1908 exit; 1909 when 'N' | 'n' => 1910 TIO.Put_Line ("no"); 1911 if Unix.external_command (command) then 1912 needs_gen := False; 1913 end if; 1914 exit; 1915 when others => null; 1916 end case; 1917 end loop; 1918 TIO.Put_Line (stars); 1919 end if; 1920 end if; 1921 else 1922 needs_gen := False; 1923 end if; 1924 end if; 1925 1926 if needs_gen then 1927 return generate_ports_index (index_file, portsdir); 1928 else 1929 return True; 1930 end if; 1931 end ensure_port_index; 1932 1933 1934 ------------------------- 1935 -- index_out_of_date -- 1936 ------------------------- 1937 function index_out_of_date (index_file : String; valid : out Boolean) return Boolean 1938 is 1939 index_file_modtime : CAL.Time; 1940 result : Boolean; 1941 begin 1942 valid := False; 1943 begin 1944 index_file_modtime := AD.Modification_Time (index_file); 1945 exception 1946 when AD.Use_Error => 1947 TIO.Put_Line ("File system doesn't support modification times, must eject!"); 1948 return False; 1949 when others => 1950 TIO.Put_Line ("index_out_of_date: problem getting index file modification time"); 1951 return False; 1952 end; 1953 result := PortScan.tree_newer_than_reference 1954 (portsdir => JT.USS (PM.configuration.dir_portsdir), 1955 reference => index_file_modtime, 1956 valid => valid); 1957 if valid then 1958 return result; 1959 else 1960 TIO.Put_Line ("Failed to determine if index is out of date, must eject!"); 1961 return False; 1962 end if; 1963 end index_out_of_date; 1964 1965 1966 ------------------------------ 1967 -- tree_directories_match -- 1968 ------------------------------ 1969 function tree_directories_match (index_file, portsdir : String) return Boolean 1970 is 1971 procedure flavor_line (cursor : string_crate.Cursor); 1972 1973 last_entry : JT.Text; 1974 broken : Boolean := False; 1975 1976 procedure flavor_line (cursor : string_crate.Cursor) 1977 is 1978 line : constant String := JT.USS (string_crate.Element (Position => cursor)); 1979 catport : JT.Text := JT.SUS (JT.part_1 (line, "@")); 1980 begin 1981 if not broken then 1982 if not JT.equivalent (last_entry, catport) then 1983 last_entry := catport; 1984 if ports_keys.Contains (catport) then 1985 ports_keys.Delete (catport); 1986 else 1987 broken := True; 1988 end if; 1989 end if; 1990 end if; 1991 end flavor_line; 1992 begin 1993 load_index_for_store_origins; 1994 prescan_ports_tree (portsdir); 1995 1996 so_serial.Iterate (flavor_line'Access); 1997 if not broken then 1998 -- Every port on the flavor index is present in the ports tree 1999 -- We still need to check that there are not ports in the tree not listed in index 2000 if not ports_keys.Is_Empty then 2001 broken := True; 2002 end if; 2003 end if; 2004 2005 reset_ports_tree; 2006 clear_store_origin_data; 2007 return not broken; 2008 end tree_directories_match; 2009 2010end PortScan.Pilot; 2011