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