setup/setup-openssh.pl

   1 #!/usr/bin/perl
   2 #
   3 # setup-openssh.pl
   4 #
   5 # Adapts the installed gsi-openssh environment to the current machine,
   6 # performing actions that originally occurred during the package's
   7 # 'make install' phase.
   8 #
   9 # Send comments/fixes/suggestions to:
  10 # Chase Phillips <cphillip@ncsa.uiuc.edu>
  11 #
  12
  13 #
  14 # Get user's GPT_LOCATION since we may be installing this using a new(er)
  15 # version of GPT.
  16 #
  17
  18 $gptpath = $ENV{GPT_LOCATION};
  19
  20 #
  21 # And the old standby..
  22 #
  23
  24 $gpath = $ENV{GLOBUS_LOCATION};
  25 if (!defined($gpath))
  26 {
  27     exitDie("ERROR: GLOBUS_LOCATION needs to be set before running this script!\n");
  28 }
  29
  30 #
  31 # Include standard modules
  32 #
  33
  34 use Getopt::Long;
  35 use Cwd;
  36 use Cwd 'abs_path';
  37
  38 #
  39 # i'm including this because other perl scripts in the gpt setup directories
  40 # do so
  41 #
  42
  43 if (defined($gptpath))
  44 {
  45     @INC = (@INC, "$gptpath/lib/perl", "$gpath/lib/perl");
  46 }
  47 else
  48 {
  49     @INC = (@INC, "$gpath/lib/perl");
  50 }
  51
  52 require Grid::GPT::Setup;
  53
  54 #
  55 # script-centred variable initialization
  56 #
  57
  58 my $globusdir = $gpath;
  59 my $myname = "setup-openssh.pl";
  60
  61 #
  62 # Set up path prefixes for use in the path translations
  63 #
  64
  65 $prefix = ${globusdir};
  66 $exec_prefix = "${prefix}";
  67 $bindir = "${exec_prefix}/bin/ssh.d";
  68 $sbindir = "${exec_prefix}/sbin";
  69 $sysconfdir = "$prefix/etc/ssh";
  70 $localsshdir = "/etc/ssh";
  71 $setupdir = "$prefix/setup/gsi_openssh_setup";
  72
  73 #
  74 # standard key types and their root file name mappings
  75 #
  76
  77 my $keyfiles = {
  78                  "dsa" => "ssh_host_dsa_key",
  79                  "rsa" => "ssh_host_rsa_key",
  80                  "rsa1" => "ssh_host_key",
  81                };
  82
  83 #
  84 # argument specification.  we offload some processing work from later functions
  85 # to verify correct args by using anon subs in various places.
  86 #
  87
  88 my($prompt, $force, $verbose);
  89
  90 $prompt = 1;
  91 $verbose = 0;
  92
  93 GetOptions(
  94             'prompt!' => \$prompt,
  95             'force' => \$force,
  96             'verbose' => \$verbose,
  97           ) or pod2usage(2);
  98
  99 #
 100 # miscellaneous initialization functions
 101 #
 102
 103 setPrivilegeSeparation(0);
 104
 105 #
 106 # main execution.  This should find its way into a subroutine at some future
 107 # point.
 108 #
 109
 110 debug0("Configuring gsi_openssh\n");
 111 debug0("------------------------------------------------------------\n");
 112 debug0("Executing...\n");
 113
 114 makeConfDir();
 115 copyPRNGFile();
 116 $keyhash = determineKeys();
 117 runKeyGen($keyhash->{gen});
 118 linkKeyFiles($keyhash->{link});
 119 copyConfigFiles();
 120
 121 my $metadata = new Grid::GPT::Setup(package_name => "gsi_openssh_setup");
 122
 123 $metadata->finish();
 124
 125 debug0("\n");
 126 debug0("Notes:\n\n");
 127
 128 if ( getPrivilegeSeparation() )
 129 {
 130     debug0("  o Privilege separation is on.\n");
 131 }
 132 elsif ( !getPrivilegeSeparation() )
 133 {
 134     debug0("  o Privilege separation is off.\n");
 135 }
 136
 137 debug0("  o GSI-OpenSSH website is <http://grid.ncsa.uiuc.edu/ssh/>.\n");
 138 debug0("------------------------------------------------------------\n");
 139 debug0("Finished configuring gsi_openssh.\n");
 140
 141 exit;
 142
 143 #
 144 # subroutines
 145 #
 146
 147 ### initPRNGHash( )
 148 #
 149 # initialize the PRNG pathname hash
 150 #
 151
 152 sub initPRNGHash( )
 153 {
 154     #
 155     # standard prng to executable conversion names
 156     #
 157
 158     addPRNGCommand("\@PROG_LS\@", "ls");
 159     addPRNGCommand("\@PROG_NETSTAT\@", "netstat");
 160     addPRNGCommand("\@PROG_ARP\@", "arp");
 161     addPRNGCommand("\@PROG_IFCONFIG\@", "ifconfig");
 162     addPRNGCommand("\@PROG_PS\@", "ps");
 163     addPRNGCommand("\@PROG_JSTAT\@", "jstat");
 164     addPRNGCommand("\@PROG_W\@", "w");
 165     addPRNGCommand("\@PROG_WHO\@", "who");
 166     addPRNGCommand("\@PROG_LAST\@", "last");
 167     addPRNGCommand("\@PROG_LASTLOG\@", "lastlog");
 168     addPRNGCommand("\@PROG_DF\@", "df");
 169     addPRNGCommand("\@PROG_SAR\@", "sar");
 170     addPRNGCommand("\@PROG_VMSTAT\@", "vmstat");
 171     addPRNGCommand("\@PROG_UPTIME\@", "uptime");
 172     addPRNGCommand("\@PROG_IPCS\@", "ipcs");
 173     addPRNGCommand("\@PROG_TAIL\@", "tail");
 174
 175     debug1("Determining paths for PRNG commands...\n");
 176
 177     $paths = determinePRNGPaths();
 178
 179     return;
 180 }
 181
 182 ### getDirectoryPaths( )
 183 #
 184 # return an array ref containing all of the directories in which we should search
 185 # for our listing of executable names.
 186 #
 187
 188 sub getDirectoryPaths( )
 189 {
 190     #
 191     # read in the PATH environmental variable and prepend a set of 'safe'
 192     # directories from which to test PRNG commands.
 193     #
 194
 195     $path = $ENV{PATH};
 196     $path = "/bin:/usr/bin:/sbin:/usr/sbin:/etc:" . $path;
 197     @dirs = split(/:/, $path);
 198
 199     #
 200     # sanitize each directory listed in the array.
 201     #
 202
 203     @dirs = map {
 204                   $tmp = $_;
 205                   $tmp =~ s:/+:/:g;
 206                   $tmp =~ s:^\s+|\s+$::g;
 207                   $tmp;
 208                 } @dirs;
 209
 210     return \@dirs;
 211 }
 212
 213 ### addPRNGCommand( $prng_name, $exec_name )
 214 #
 215 # given a PRNG name and a corresponding executable name, add it to our list of
 216 # PRNG commands for which to find on the system.
 217 #
 218
 219 sub addPRNGCommand
 220 {
 221     my($prng_name, $exec_name) = @_;
 222
 223     prngAddNode($prng_name, $exec_name);
 224 }
 225
 226 ### copyPRNGFile( )
 227 #
 228 # read in ssh_prng_cmds.in, translate the program listings to the paths we have
 229 # found on the local system, and then write the output to ssh_prng_cmds.
 230 #
 231
 232 sub copyPRNGFile
 233 {
 234     my($fileInput, $fileOutput);
 235     my($mode, $uid, $gid);
 236     my($data);
 237
 238     if ( isPresent("$sysconfdir/ssh_prng_cmds") && !isForced() )
 239     {
 240         debug1("ssh_prng_cmds found and not forced.  Not installing ssh_prng_cmds...\n");
 241         return;
 242     }
 243
 244     initPRNGHash();
 245
 246     debug1("Fixing paths in ssh_prng_cmds...\n");
 247
 248     $fileInput = "$setupdir/ssh_prng_cmds.in";
 249     $fileOutput = "$sysconfdir/ssh_prng_cmds";
 250
 251     #
 252     # verify that we are prepared to work with $fileInput
 253     #
 254
 255     if ( !isReadable($fileInput) )
 256     {
 257         debug1("Cannot read $fileInput... skipping.\n");
 258         return;
 259     }
 260
 261     #
 262     # verify that we are prepared to work with $fileOuput
 263     #
 264
 265     if ( !prepareFileWrite($fileOutput) )
 266     {
 267         return;
 268     }
 269
 270     #
 271     # Grab the current mode/uid/gid for use later
 272     #
 273
 274     $mode = (stat($fileInput))[2];
 275     $uid = (stat($fileInput))[4];
 276     $gid = (stat($fileInput))[5];
 277
 278     #
 279     # Open the files for reading and writing, and loop over the input's contents
 280     #
 281
 282     $data = readFile($fileInput);
 283     for my $k (keys %$prngcmds)
 284     {
 285         $sub = prngGetExecPath($k);
 286         $data =~ s:$k:$sub:g;
 287     }
 288     writeFile($fileOutput, $data);
 289
 290     #
 291     # An attempt to revert the new file back to the original file's
 292     # mode/uid/gid
 293     #
 294
 295     chmod($mode, $fileOutput);
 296     chown($uid, $gid, $fileOutput);
 297
 298     return 0;
 299 }
 300
 301 ### determinePRNGPaths( )
 302 #
 303 # for every entry in the PRNG hash, seek out and find the path for the
 304 # corresponding executable name.
 305 #
 306
 307 sub determinePRNGPaths
 308 {
 309     my(@paths, @dirs);
 310     my($exec_name, $exec_path);
 311
 312     $dirs = getDirectoryPaths();
 313
 314     for my $k (keys %$prngcmds)
 315     {
 316         $exec_name = prngGetExecName($k);
 317         $exec_path = findExecutable($exec_name, $dirs);
 318         prngSetExecPath($k, $exec_path);
 319     }
 320
 321     return;
 322 }
 323
 324 ### prngAddNode( $prng_name, $exec_name )
 325 #
 326 # add a new node to the PRNG hash
 327 #
 328
 329 sub prngAddNode
 330 {
 331     my($prng_name, $exec_name) = @_;
 332     my($node);
 333
 334     if (!defined($prngcmds))
 335     {
 336         $prngcmds = {};
 337     }
 338
 339     $node = {};
 340     $node->{prng} = $prng_name;
 341     $node->{exec} = $exec_name;
 342
 343     $prngcmds->{$prng_name} = $node;
 344 }
 345
 346 ### prngGetExecName( $key )
 347 #
 348 # get the executable name from the prng commands hash named by $key
 349 #
 350
 351 sub prngGetExecName
 352 {
 353     my($key) = @_;
 354
 355     return $prngcmds->{$key}->{exec};
 356 }
 357
 358 ### prngGetExecPath( $key )
 359 #
 360 # get the executable path from the prng commands hash named by $key
 361 #
 362
 363 sub prngGetExecPath
 364 {
 365     my($key) = @_;
 366
 367     return $prngcmds->{$key}->{exec_path};
 368 }
 369
 370 ### prngGetNode( $key )
 371 #
 372 # return a reference to the node named by $key
 373 #
 374
 375 sub prngGetNode
 376 {
 377     my($key) = @_;
 378
 379     return ${$prngcmds}{$key};
 380 }
 381
 382 ### prngSetExecPath( $key, $path )
 383 #
 384 # given a key, set the executable path in that node to $path
 385 #
 386
 387 sub prngSetExecPath
 388 {
 389     my($key, $path) = @_;
 390
 391     $prngcmds->{$key}->{exec_path} = $path;
 392 }
 393
 394 ### findExecutable( $exec_name, $dirs )
 395 #
 396 # given an executable name, test each possible path in $dirs to see if such
 397 # an executable exists.
 398 #
 399
 400 sub findExecutable
 401 {
 402     my($exec_name, $dirs) = @_;
 403
 404     for my $d (@$dirs)
 405     {
 406         $test = "$d/$exec_name";
 407
 408         if ( isExecutable($test) )
 409         {
 410             return $test;
 411         }
 412     }
 413
 414     return "undef";
 415 }
 416
 417 ### linkKeyFiles( $linklist )
 418 #
 419 # given an array of keys to link, link both the key and its public variant into
 420 # the gsi-openssh configuration directory.
 421 #
 422
 423 sub linkKeyFiles
 424 {
 425     my($linklist) = @_;
 426     my($regex, $basename);
 427
 428     if (@$linklist)
 429     {
 430         debug1("Linking ssh host keys...\n");
 431
 432         for my $f (@$linklist)
 433         {
 434             $f =~ s:/+:/:g;
 435
 436             if (length($f) > 0)
 437             {
 438                 $keyfile = "$f";
 439                 $pubkeyfile = "$f.pub";
 440
 441                 linkFile("$localsshdir/$keyfile", "$sysconfdir/$keyfile");
 442                 linkFile("$localsshdir/$pubkeyfile", "$sysconfdir/$pubkeyfile");
 443             }
 444         }
 445     }
 446 }
 447
 448 ### isForced( )
 449 #
 450 # return true if the user passed in the force flag.  return false otherwise.
 451 #
 452
 453 sub isForced
 454 {
 455     if ( defined($force) && $force )
 456     {
 457         return 1;
 458     }
 459     else
 460     {
 461         return 0;
 462     }
 463 }
 464
 465 ### isReadable( $file )
 466 #
 467 # given a file, return true if that file both exists and is readable by the
 468 # effective user id.  return false otherwise.
 469 #
 470
 471 sub isReadable
 472 {
 473     my($file) = @_;
 474
 475     if ( ( -e $file ) && ( -r $file ) )
 476     {
 477         return 1;
 478     }
 479     else
 480     {
 481         return 0;
 482     }
 483 }
 484
 485 ### isExecutable( $file )
 486 #
 487 # return true if $file is executable.  return false otherwise.
 488 #
 489
 490 sub isExecutable
 491 {
 492     my($file) = @_;
 493
 494     if ( -x $file )
 495     {
 496         return 1;
 497     }
 498     else
 499     {
 500         return 0;
 501     }
 502 }
 503
 504 ### isWritable( $file )
 505 #
 506 # given a file, return true if that file does not exist or is writable by the
 507 # effective user id.  return false otherwise.
 508 #
 509
 510 sub isWritable
 511 {
 512     my($file) = @_;
 513
 514     if ( ( ! -e $file ) || ( -w $file ) )
 515     {
 516         return 1;
 517     }
 518     else
 519     {
 520         return 0;
 521     }
 522 }
 523
 524 ### isPresent( $file )
 525 #
 526 # given a file, return true if that file exists.  return false otherwise.
 527 #
 528
 529 sub isPresent
 530 {
 531     my($file) = @_;
 532
 533     if ( -e $file )
 534     {
 535         return 1;
 536     }
 537     else
 538     {
 539         return 0;
 540     }
 541 }
 542
 543 ### makeConfDir( )
 544 #
 545 # make the gsi-openssh configuration directory if it doesn't already exist.
 546 #
 547
 548 sub makeConfDir
 549 {
 550     if ( isPresent($sysconfdir) )
 551     {
 552         if ( -d $sysconfdir )
 553         {
 554             return;
 555         }
 556
 557         debug1("${sysconfdir} already exists and is not a directory!\n");
 558         exit;
 559     }
 560
 561     debug1("Could not find ${sysconfdir} directory... creating.\n");
 562     action("mkdir -p $sysconfdir");
 563
 564     return;
 565 }
 566
 567 ### determineKeys( )
 568 #
 569 # based on a set of key types, triage them to determine if for each key type, that
 570 # key type should be copied from the main ssh configuration directory, or if it
 571 # should be generated using ssh-keygen.
 572 #
 573
 574 sub determineKeys
 575 {
 576     my($keyhash, $keylist);
 577     my($count);
 578
 579     #
 580     # initialize our variables
 581     #
 582
 583     $count = 0;
 584
 585     $keyhash = {};
 586     $keyhash->{gen} = [];   # a list of keytypes to generate
 587     $keyhash->{link} = [];  # a list of files to link
 588
 589     $genlist = $keyhash->{gen};
 590     $linklist = $keyhash->{link};
 591
 592     #
 593     # loop over our keytypes and determine what we need to do for each of them
 594     #
 595
 596     for my $keytype (keys %$keyfiles)
 597     {
 598         $basekeyfile = $keyfiles->{$keytype};
 599
 600         #
 601         # if the key's are already present, we don't need to bother with this rigamarole
 602         #
 603
 604         $gkeyfile = "$sysconfdir/$basekeyfile";
 605         $gpubkeyfile = "$sysconfdir/$basekeyfile.pub";
 606
 607         if ( isPresent($gkeyfile) && isPresent($gpubkeyfile) )
 608         {
 609             if ( isForced() )
 610             {
 611                 if ( isWritable("$sysconfdir/$basekeyfile") && isWritable("$sysconfdir/$basekeyfile.pub") )
 612                 {
 613                      action("rm $sysconfdir/$basekeyfile");
 614                      action("rm $sysconfdir/$basekeyfile.pub");
 615                 }
 616                 else
 617                 {
 618                      next;
 619                 }
 620             }
 621         }
 622
 623         #
 624         # if we can find a copy of the keys in /etc/ssh, we'll link them to the user's
 625         # globus location
 626         #
 627
 628         $mainkeyfile = "$localsshdir/$basekeyfile";
 629         $mainpubkeyfile = "$localsshdir/$basekeyfile.pub";
 630
 631         if ( isPresent($mainkeyfile) && isPresent($mainpubkeyfile) )
 632         {
 633             push(@$linklist, $basekeyfile);
 634             $count++;
 635             next;
 636         }
 637
 638         #
 639         # otherwise, we need to generate the key
 640         #
 641
 642         push(@$genlist, $keytype);
 643         $count++;
 644     }
 645
 646     return $keyhash;
 647 }
 648
 649 ### runKeyGen( $gen_keys )
 650 #
 651 # given a set of key types, generate private and public keys for that key type and
 652 # place them in the gsi-openssh configuration directory.
 653 #
 654
 655 sub runKeyGen
 656 {
 657     my($gen_keys) = @_;
 658     my $keygen = "$bindir/ssh-keygen";
 659
 660     if (@$gen_keys && -x $keygen)
 661     {
 662         debug1("Generating ssh host keys...\n");
 663
 664         for my $k (@$gen_keys)
 665         {
 666             $keyfile = $keyfiles->{$k};
 667
 668             if ( !isPresent("$sysconfdir/$keyfile") )
 669             {
 670                 action("$bindir/ssh-keygen -t $k -f $sysconfdir/$keyfile -N \"\"");
 671             }
 672         }
 673     }
 674
 675     return 0;
 676 }
 677
 678 ### copySSHDConfigFile( )
 679 #
 680 # this subroutine 'edits' the paths in sshd_config to suit them to the current environment
 681 # in which the setup script is being run.
 682 #
 683
 684 sub copySSHDConfigFile
 685 {
 686     my($fileInput, $fileOutput);
 687     my($mode, $uid, $gid);
 688     my($line, $newline);
 689     my($privsep_enabled);
 690
 691     debug1("Fixing paths in sshd_config...\n");
 692
 693     $fileInput = "$setupdir/sshd_config.in";
 694     $fileOutput = "$sysconfdir/sshd_config";
 695
 696     #
 697     # verify that we are prepared to work with $fileInput
 698     #
 699
 700     if ( !isReadable($fileInput) )
 701     {
 702         debug1("Cannot read $fileInput... skipping.\n");
 703         return;
 704     }
 705
 706     #
 707     # verify that we are prepared to work with $fileOuput
 708     #
 709
 710     if ( !prepareFileWrite($fileOutput) )
 711     {
 712         return;
 713     }
 714
 715     #
 716     # check to see whether we should enable privilege separation
 717     #
 718
 719     if ( userExists("sshd") && ( -d "/var/empty" ) && ( getOwnerID("/var/empty") eq 0 ) )
 720     {
 721         setPrivilegeSeparation(1);
 722     }
 723     else
 724     {
 725         setPrivilegeSeparation(0);
 726     }
 727
 728     if ( getPrivilegeSeparation() )
 729     {
 730         $privsep_enabled = "yes";
 731     }
 732     else
 733     {
 734         $privsep_enabled = "no";
 735     }
 736
 737     #
 738     # Grab the current mode/uid/gid for use later
 739     #
 740
 741     $mode = (stat($fileInput))[2];
 742     $uid = (stat($fileInput))[4];
 743     $gid = (stat($fileInput))[5];
 744
 745     #
 746     # Open the files for reading and writing, and loop over the input's contents
 747     #
 748
 749     $data = readFile($fileInput);
 750
 751     # #
 752     # # alter the PidFile config
 753     # #
 754     #
 755     # $text = "PidFile\t$gpath/var/sshd.pid";
 756     # $data =~ s:^[\s|#]*PidFile.*$:$text:gm;
 757
 758     #
 759     # set the sftp directive
 760     #
 761
 762     $text = "Subsystem\tsftp\t$gpath/libexec/sftp-server";
 763     $data =~ s:^[\s|#]*Subsystem\s+sftp\s+.*$:$text:gm;
 764
 765     #
 766     # set the privilege separation directive
 767     #
 768
 769     $text = "UsePrivilegeSeparation\t${privsep_enabled}";
 770     $data =~ s:^[\s|#]*UsePrivilegeSeparation.*$:$text:gm;
 771
 772     #
 773     # dump the modified output to the config file
 774     #
 775
 776     writeFile($fileOutput, $data);
 777
 778     #
 779     # An attempt to revert the new file back to the original file's
 780     # mode/uid/gid
 781     #
 782
 783     chmod($mode, $fileOutput);
 784     chown($uid, $gid, $fileOutput);
 785
 786     return 0;
 787 }
 788
 789 ### setPrivilegeSeparation( $value )
 790 #
 791 # set the privilege separation variable to $value
 792 #
 793
 794 sub setPrivilegeSeparation
 795 {
 796     my($value) = @_;
 797
 798     $privsep = $value;
 799 }
 800
 801 ### getPrivilegeSeparation( )
 802 #
 803 # return the value of the privilege separation variable
 804 #
 805
 806 sub getPrivilegeSeparation
 807 {
 808     return $privsep;
 809 }
 810
 811 ### prepareFileWrite( $file )
 812 #
 813 # test $file to prepare for writing to it.
 814 #
 815
 816 sub prepareFileWrite
 817 {
 818     my($file) = @_;
 819
 820     if ( isPresent($file) )
 821     {
 822         debug1("$file already exists... ");
 823
 824         if ( isForced() )
 825         {
 826             if ( isWritable($file) )
 827             {
 828                 debug1("removing.\n");
 829                 action("rm $file");
 830                 return 1;
 831             }
 832             else
 833             {
 834                 debug1("not writable -- skipping.\n");
 835                 return 0;
 836             }
 837         }
 838         else
 839         {
 840             debug1("skipping.\n");
 841             return 0;
 842         }
 843     }
 844
 845     return 1;
 846 }
 847
 848 ### copyConfigFiles( )
 849 #
 850 # subroutine that copies some extra config files to their proper location in
 851 # $GLOBUS_LOCATION/etc/ssh.
 852 #
 853
 854 sub copyConfigFiles
 855 {
 856     #
 857     # copy the sshd_config file into the ssh configuration directory and alter
 858     # the paths in the file.
 859     #
 860
 861     copySSHDConfigFile();
 862
 863     #
 864     # do straight copies of the ssh_config and moduli files.
 865     #
 866
 867     debug1("Copying ssh_config and moduli to their proper location...\n");
 868
 869     copyFile("$setupdir/ssh_config", "$sysconfdir/ssh_config");
 870     copyFile("$setupdir/moduli", "$sysconfdir/moduli");
 871
 872     #
 873     # copy and alter the SXXsshd script.
 874     #
 875
 876     copySXXScript("$setupdir/SXXsshd.in", "$sbindir/SXXsshd");
 877 }
 878
 879 ### linkFile( $src, $dest )
 880 #
 881 # create a symbolic link from $src to $dest.
 882 #
 883
 884 sub linkFile
 885 {
 886     my($src, $dest) = @_;
 887
 888     if ( !isPresent($src) )
 889     {
 890         debug1("$src is not readable... not creating $dest.\n");
 891         return;
 892     }
 893
 894     if ( !prepareFileWrite($dest) )
 895     {
 896         return;
 897     }
 898
 899     action("ln -s $src $dest");
 900 }
 901
 902 ### copyFile( $src, $dest )
 903 #
 904 # copy the file pointed to by $src to the location specified by $dest.  in the
 905 # process observe the rules regarding when the '-force' flag was passed to us.
 906 #
 907
 908 sub copyFile
 909 {
 910     my($src, $dest) = @_;
 911
 912     if ( !isReadable($src) )
 913     {
 914         debug1("$src is not readable... not creating $dest.\n");
 915         return;
 916     }
 917
 918     if ( !prepareFileWrite($dest) )
 919     {
 920         return;
 921     }
 922
 923     action("cp $src $dest");
 924 }
 925
 926 ### copySXXScript( $in, $out )
 927 #
 928 # parse the input file, substituting in place the value of GLOBUS_LOCATION, and
 929 # write the result to the output file.
 930 #
 931
 932 sub copySXXScript
 933 {
 934     my($in, $out) = @_;
 935     my($tmpgpath);
 936
 937     if ( !isReadable($in) )
 938     {
 939         debug1("$in is not readable... not creating $out.\n");
 940         return;
 941     }
 942
 943     if ( !prepareFileWrite($out) )
 944     {
 945         return;
 946     }
 947
 948     #
 949     # clean up any junk in the globus path variable
 950     #
 951
 952     $tmpgpath = $gpath;
 953     $tmpgpath =~ s:/+:/:g;
 954     $tmpgpath =~ s:([^/]+)/$:\1:g;
 955
 956     #
 957     # read in the script, substitute globus location, then write it back out
 958     #
 959
 960     $data = readFile($in);
 961     $data =~ s|\@GLOBUS_LOCATION\@|$tmpgpath|g;
 962     writeFile($out, $data);
 963     action("chmod 755 $out");
 964 }
 965
 966 ### readFile( $filename )
 967 #
 968 # reads and returns $filename's contents
 969 #
 970
 971 sub readFile
 972 {
 973     my($filename) = @_;
 974     my($data);
 975
 976     open(IN, "$filename") || exitDie("ERROR: Can't open '$filename': $!\n");
 977     $/ = undef;
 978     $data = <IN>;
 979     $/ = "\n";
 980     close(IN);
 981
 982     return $data;
 983 }
 984
 985 ### writeFile( $filename, $fileinput )
 986 #
 987 # create the inputs to the ssl program at $filename, appending the common name to the
 988 # stream in the process
 989 #
 990
 991 sub writeFile
 992 {
 993     my($filename, $fileinput) = @_;
 994
 995     #
 996     # test for a valid $filename
 997     #
 998
 999     if ( !defined($filename) || (length($filename) lt 1) )
1000     {
1001         exitDie("ERROR: Filename is undefined!\n");
1002     }
1003
1004     #
1005     # verify that we are prepared to work with $filename
1006     #
1007
1008     if ( !prepareFileWrite($filename) )
1009     {
1010         return;
1011     }
1012
1013     #
1014     # write the output to $filename
1015     #
1016
1017     open(OUT, ">$filename");
1018     print OUT "$fileinput";
1019     close(OUT);
1020 }
1021
1022 ### debug1( $arg1, $arg2 )
1023 #
1024 # Print out a debugging message at level 1.
1025 #
1026
1027 sub debug1
1028 {
1029     debug(string => \@_, level => 1);
1030 }
1031
1032 ### debug0( $arg1, $arg2 )
1033 #
1034 # Print out a debugging message at level 0.
1035 #
1036
1037 sub debug0
1038 {
1039     debug(string => \@_, level => 0);
1040 }
1041
1042 ### debug( string => $string, level => $level )
1043 #
1044 # Print out debugging messages at various levels.  Feel free to use debugN() directly
1045 # which in turn calls this subroutine.
1046 #
1047
1048 sub debug
1049 {
1050     my %args = @_;
1051
1052     if (!defined($args{'level'}))
1053     {
1054         $args{'level'} = 0;
1055     }
1056
1057     if ($verbose >= $args{'level'})
1058     {
1059         printf(@{$args{'string'}});
1060     }
1061 }
1062
1063 ### action( $command )
1064 #
1065 # run $command within a proper system() command.
1066 #
1067
1068 sub action
1069 {
1070     my($command) = @_;
1071
1072     debug1("$command\n");
1073
1074     my $result = system("$command >/dev/null 2>&1");
1075
1076     if (($result or $?) and $command !~ m!patch!)
1077     {
1078         exitDie("ERROR: Unable to execute $command: $!\n");
1079     }
1080 }
1081
1082 ### exitDie( $error )
1083 #
1084 # a horribly named method meant to look like die but only exit, thereby not causing
1085 # gpt-postinstall to croak.
1086 #
1087
1088 sub exitDie
1089 {
1090     my($error) = @_;
1091
1092     print $error;
1093     exit;
1094 }
1095
1096 ### query_boolean( $query_text, $default )
1097 #
1098 # query the user with a string, and expect a response.  If the user hits
1099 # 'enter' instead of entering an input, then accept the default response.
1100 #
1101
1102 sub query_boolean
1103 {
1104     my($query_text, $default) = @_;
1105     my($nondefault, $foo, $bar);
1106
1107     if ( !$prompt )
1108     {
1109         print "Prompt suppressed.  Continuing...\n";
1110         return "y";
1111     }
1112
1113     #
1114     # Set $nondefault to the boolean opposite of $default.
1115     #
1116
1117     if ($default eq "n")
1118     {
1119         $nondefault = "y";
1120     }
1121     else
1122     {
1123         $nondefault = "n";
1124     }
1125
1126     print "${query_text} ";
1127     print "[$default] ";
1128
1129     $foo = <STDIN>;
1130     ($bar) = split //, $foo;
1131
1132     if ( grep(/\s/, $bar) )
1133     {
1134         # this is debatable.  all whitespace means 'default'
1135
1136         $bar = $default;
1137     }
1138     elsif ($bar eq '')
1139     {
1140         $bar = $default;
1141     }
1142     elsif ($bar ne $default)
1143     {
1144         # everything else means 'nondefault'.
1145
1146         $bar = $nondefault;
1147     }
1148     else
1149     {
1150         # extraneous step.  to get here, $bar should be eq to $default anyway.
1151
1152         $bar = $default;
1153     }
1154
1155     return $bar;
1156 }
1157
1158 ### absolutePath( $file )
1159 #
1160 # converts a given pathname into a canonical path using the abs_path function.
1161 #
1162
1163 sub absolutePath
1164 {
1165     my($file) = @_;
1166     my $home = $ENV{'HOME'};
1167     $file =~ s!~!$home!;
1168     my $startd = cwd();
1169     $file =~ s!^\./!$startd/!;
1170     $file = "$startd/$file" if $file !~ m!^\s*/!;
1171     $file = abs_path($file);
1172     return $file;
1173 }
1174
1175 ### getOwnerID( $file )
1176 #
1177 # return the uid containing the owner ID of the given file.
1178 #
1179
1180 sub getOwnerID
1181 {
1182     my($file) = @_;
1183     my($uid);
1184
1185     #
1186     # call stat() to get the mode of the file
1187     #
1188
1189     $uid = (stat($file))[4];
1190
1191     return $uid;
1192 }
1193
1194 ### getMode( $file )
1195 #
1196 # return a string containing the mode of the given file.
1197 #
1198
1199 sub getMode
1200 {
1201     my($file) = @_;
1202     my($tempmode, $mode);
1203
1204     #
1205     # call stat() to get the mode of the file
1206     #
1207
1208     $tempmode = (stat($file))[2];
1209     if (length($tempmode) < 1)
1210     {
1211         return "";
1212     }
1213
1214     #
1215     # call sprintf to format the mode into a UNIX-like string
1216     #
1217
1218     $mode = sprintf("%04o", $tempmode & 07777);
1219
1220     return $mode;
1221 }
1222
1223 ### userExists( $username )
1224 #
1225 # given a username, return true if the user exists on the system.  return false
1226 # otherwise.
1227 #
1228
1229 sub userExists
1230 {
1231     my($username) = @_;
1232     my($uid);
1233
1234     #
1235     # retrieve the userid of the user with the given username
1236     #
1237
1238     $uid = getpwnam($username);
1239
1240     #
1241     # return true if $uid is defined and has a length greater than 0
1242     #
1243
1244     if ( defined($uid) and (length($uid) > 0) )
1245     {
1246         return 1;
1247     }
1248     else
1249     {
1250         return 0;
1251     }
1252 }