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