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     die "GLOBUS_LOCATION needs to be set before running this script"
  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($interactive, $force, $verbose);
 101
 102 GetOptions(
 103             'interactive!' => \$interactive,
 104             'force' => \$force,
 105             'verbose' => \$verbose,
 106           ) or pod2usage(2);
 107
 108 #
 109 # main execution.  This should find its way into a subroutine at some future
 110 # point.
 111 #
 112
 113 print "$myname: Configuring package 'gsi_openssh'...\n";
 114 print "---------------------------------------------------------------------\n";
 115 print "Hi, I'm the setup script for the gsi_openssh package!  There\n";
 116 print "are some last minute details that I've got to set straight\n";
 117 print "in the sshd config file, along with generating the ssh keys\n";
 118 print "for this machine (if it doesn't already have them).\n";
 119 print "\n";
 120 print "If I find a pair of host keys in /etc/ssh, I will copy them into\n";
 121 print "\$GLOBUS_LOCATION/etc/ssh.  If they aren't present, I will generate\n";
 122 print "them for you.\n";
 123 print "\n";
 124
 125 $response = query_boolean("Do you wish to continue with the setup package?","y");
 126 if ($response eq "n")
 127 {
 128     print "\n";
 129     print "Exiting gsi_openssh setup.\n";
 130
 131     exit 0;
 132 }
 133
 134 print "\n";
 135
 136 makeConfDir();
 137 $keyhash = determineKeys();
 138 runKeyGen($keyhash->{gen});
 139 copyKeyFiles($keyhash->{copy});
 140 copyConfigFiles();
 141 copyPRNGFile();
 142
 143 my $metadata = new Grid::GPT::Setup(package_name => "gsi_openssh_setup");
 144
 145 $metadata->finish();
 146
 147 print "\n";
 148 print "Additional Notes:\n";
 149 print "\n";
 150 print "  o I see that you have your GLOBUS_LOCATION environmental variable\n";
 151 print "    set to:\n";
 152 print "\n";
 153 print "    \t\"$gpath\"\n";
 154 print "\n";
 155 print "    Remember to keep this variable set (correctly) when you want to\n";
 156 print "    use the executables that came with this package.\n";
 157 print "\n";
 158 print "    After that you may run, e.g.:\n";
 159 print "\n";
 160 print "    \t\$ . \$GLOBUS_LOCATION/etc/globus-user-env.sh\n";
 161 print "\n";
 162 print "    to prepare your environment for running the gsi_openssh\n";
 163 print "    executables.\n";
 164 print "---------------------------------------------------------------------\n";
 165 print "$myname: Finished configuring package 'gsi_openssh'.\n";
 166
 167 exit;
 168
 169 #
 170 # subroutines
 171 #
 172
 173 ### initPRNGHash( )
 174 #
 175 # initialize the PRNG pathname hash
 176 #
 177
 178 sub initPRNGHash( )
 179 {
 180     #
 181     # standard prng to executable conversion names
 182     #
 183
 184     addPRNGCommand("\@PROG_LS\@", "ls");
 185     addPRNGCommand("\@PROG_NETSTAT\@", "netstat");
 186     addPRNGCommand("\@PROG_ARP\@", "arp");
 187     addPRNGCommand("\@PROG_IFCONFIG\@", "ifconfig");
 188     addPRNGCommand("\@PROG_PS\@", "ps");
 189     addPRNGCommand("\@PROG_JSTAT\@", "jstat");
 190     addPRNGCommand("\@PROG_W\@", "w");
 191     addPRNGCommand("\@PROG_WHO\@", "who");
 192     addPRNGCommand("\@PROG_LAST\@", "last");
 193     addPRNGCommand("\@PROG_LASTLOG\@", "lastlog");
 194     addPRNGCommand("\@PROG_DF\@", "df");
 195     addPRNGCommand("\@PROG_SAR\@", "sar");
 196     addPRNGCommand("\@PROG_VMSTAT\@", "vmstat");
 197     addPRNGCommand("\@PROG_UPTIME\@", "uptime");
 198     addPRNGCommand("\@PROG_IPCS\@", "ipcs");
 199     addPRNGCommand("\@PROG_TAIL\@", "tail");
 200
 201     print "Determining paths for PRNG commands...\n";
 202
 203     $paths = determinePRNGPaths();
 204
 205     return;
 206 }
 207
 208 ### getDirectoryPaths( )
 209 #
 210 # return an array ref containing all of the directories in which we should search
 211 # for our listing of executable names.
 212 #
 213
 214 sub getDirectoryPaths( )
 215 {
 216     #
 217     # read in the PATH environmental variable and prepend a set of 'safe'
 218     # directories from which to test PRNG commands.
 219     #
 220
 221     $path = $ENV{PATH};
 222     $path = "/bin:/usr/bin:/sbin:/usr/sbin:/etc:" . $path;
 223     @dirs = split(/:/, $path);
 224
 225     #
 226     # sanitize each directory listed in the array.
 227     #
 228
 229     @dirs = map {
 230                   $tmp = $_;
 231                   $tmp =~ s:/+:/:g;
 232                   $tmp =~ s:^\s+|\s+$::g;
 233                   $tmp;
 234                 } @dirs;
 235
 236     return \@dirs;
 237 }
 238
 239 ### addPRNGCommand( $prng_name, $exec_name )
 240 #
 241 # given a PRNG name and a corresponding executable name, add it to our list of
 242 # PRNG commands for which to find on the system.
 243 #
 244
 245 sub addPRNGCommand
 246 {
 247     my($prng_name, $exec_name) = @_;
 248
 249     prngAddNode($prng_name, $exec_name);
 250 }
 251
 252 ### copyPRNGFile( )
 253 #
 254 # read in ssh_prng_cmds.in, translate the program listings to the paths we have
 255 # found on the local system, and then write the output to ssh_prng_cmds.
 256 #
 257
 258 sub copyPRNGFile
 259 {
 260     my($fileInput, $fileOutput);
 261     my($mode, $uid, $gid);
 262     my($data);
 263
 264     if ( isPresent("/dev/random") && !isForced() )
 265     {
 266         printf("/dev/random found and not forced.  Not installing ssh_prng_cmds...\n");
 267         return;
 268     }
 269
 270     initPRNGHash();
 271
 272     print "Fixing paths in ssh_prng_cmds...\n";
 273
 274     $fileInput = "$setupdir/ssh_prng_cmds.in";
 275     $fileOutput = "$sysconfdir/ssh_prng_cmds";
 276
 277     #
 278     # verify that we are prepared to work with $fileInput
 279     #
 280
 281     if ( !isReadable($fileInput) )
 282     {
 283         printf("Cannot read $fileInput... skipping.\n");
 284         return;
 285     }
 286
 287     #
 288     # verify that we are prepared to work with $fileOuput
 289     #
 290
 291     if ( !prepareFileWrite($fileOutput) )
 292     {
 293         return;
 294     }
 295
 296     #
 297     # Grab the current mode/uid/gid for use later
 298     #
 299
 300     $mode = (stat($fileInput))[2];
 301     $uid = (stat($fileInput))[4];
 302     $gid = (stat($fileInput))[5];
 303
 304     #
 305     # Open the files for reading and writing, and loop over the input's contents
 306     #
 307
 308     $data = readFile($fileInput);
 309     for my $k (keys %$prngcmds)
 310     {
 311         $sub = prngGetExecPath($k);
 312         $data =~ s:$k:$sub:g;
 313     }
 314     writeFile($fileOutput, $data);
 315
 316     #
 317     # An attempt to revert the new file back to the original file's
 318     # mode/uid/gid
 319     #
 320
 321     chmod($mode, $fileOutput);
 322     chown($uid, $gid, $fileOutput);
 323
 324     return 0;
 325 }
 326
 327 ### determinePRNGPaths( )
 328 #
 329 # for every entry in the PRNG hash, seek out and find the path for the
 330 # corresponding executable name.
 331 #
 332
 333 sub determinePRNGPaths
 334 {
 335     my(@paths, @dirs);
 336     my($exec_name, $exec_path);
 337
 338     $dirs = getDirectoryPaths();
 339
 340     for my $k (keys %$prngcmds)
 341     {
 342         $exec_name = prngGetExecName($k);
 343         $exec_path = findExecutable($exec_name, $dirs);
 344         prngSetExecPath($k, $exec_path);
 345     }
 346
 347     return;
 348 }
 349
 350 ### prngAddNode( $prng_name, $exec_name )
 351 #
 352 # add a new node to the PRNG hash
 353 #
 354
 355 sub prngAddNode
 356 {
 357     my($prng_name, $exec_name) = @_;
 358     my($node);
 359
 360     if (!defined($prngcmds))
 361     {
 362         $prngcmds = {};
 363     }
 364
 365     $node = {};
 366     $node->{prng} = $prng_name;
 367     $node->{exec} = $exec_name;
 368
 369     $prngcmds->{$prng_name} = $node;
 370 }
 371
 372 ### prngGetExecName( $key )
 373 #
 374 # get the executable name from the prng commands hash named by $key
 375 #
 376
 377 sub prngGetExecName
 378 {
 379     my($key) = @_;
 380
 381     return $prngcmds->{$key}->{exec};
 382 }
 383
 384 ### prngGetExecPath( $key )
 385 #
 386 # get the executable path from the prng commands hash named by $key
 387 #
 388
 389 sub prngGetExecPath
 390 {
 391     my($key) = @_;
 392
 393     return $prngcmds->{$key}->{exec_path};
 394 }
 395
 396 ### prngGetNode( $key )
 397 #
 398 # return a reference to the node named by $key
 399 #
 400
 401 sub prngGetNode
 402 {
 403     my($key) = @_;
 404
 405     return ${$prngcmds}{$key};
 406 }
 407
 408 ### prngSetExecPath( $key, $path )
 409 #
 410 # given a key, set the executable path in that node to $path
 411 #
 412
 413 sub prngSetExecPath
 414 {
 415     my($key, $path) = @_;
 416
 417     $prngcmds->{$key}->{exec_path} = $path;
 418 }
 419
 420 ### findExecutable( $exec_name, $dirs )
 421 #
 422 # given an executable name, test each possible path in $dirs to see if such
 423 # an executable exists.
 424 #
 425
 426 sub findExecutable
 427 {
 428     my($exec_name, $dirs) = @_;
 429
 430     for my $d (@$dirs)
 431     {
 432         $test = "$d/$exec_name";
 433
 434         if ( isExecutable($test) )
 435         {
 436             return $test;
 437         }
 438     }
 439
 440     return "undef";
 441 }
 442
 443 ### copyKeyFiles( $copylist )
 444 #
 445 # given an array of keys to copy, copy both the key and its public variant into
 446 # the gsi-openssh configuration directory.
 447 #
 448
 449 sub copyKeyFiles
 450 {
 451     my($copylist) = @_;
 452     my($regex, $basename);
 453
 454     if (@$copylist)
 455     {
 456         print "Copying ssh host keys...\n";
 457
 458         for my $f (@$copylist)
 459         {
 460             $f =~ s:/+:/:g;
 461
 462             if (length($f) > 0)
 463             {
 464                 $keyfile = "$f";
 465                 $pubkeyfile = "$f.pub";
 466
 467                 copyFile("$localsshdir/$keyfile", "$sysconfdir/$keyfile");
 468                 copyFile("$localsshdir/$pubkeyfile", "$sysconfdir/$pubkeyfile");
 469             }
 470         }
 471     }
 472 }
 473
 474 ### isForced( )
 475 #
 476 # return true if the user passed in the force flag.  return false otherwise.
 477 #
 478
 479 sub isForced
 480 {
 481     if ( defined($force) && $force )
 482     {
 483         return 1;
 484     }
 485     else
 486     {
 487         return 0;
 488     }
 489 }
 490
 491 ### isReadable( $file )
 492 #
 493 # given a file, return true if that file both exists and is readable by the
 494 # effective user id.  return false otherwise.
 495 #
 496
 497 sub isReadable
 498 {
 499     my($file) = @_;
 500
 501     if ( ( -e $file ) && ( -r $file ) )
 502     {
 503         return 1;
 504     }
 505     else
 506     {
 507         return 0;
 508     }
 509 }
 510
 511 ### isExecutable( $file )
 512 #
 513 # return true if $file is executable.  return false otherwise.
 514 #
 515
 516 sub isExecutable
 517 {
 518     my($file) = @_;
 519
 520     if ( -x $file )
 521     {
 522         return 1;
 523     }
 524     else
 525     {
 526         return 0;
 527     }
 528 }
 529
 530 ### isWritable( $file )
 531 #
 532 # given a file, return true if that file does not exist or is writable by the
 533 # effective user id.  return false otherwise.
 534 #
 535
 536 sub isWritable
 537 {
 538     my($file) = @_;
 539
 540     if ( ( ! -e $file ) || ( -w $file ) )
 541     {
 542         return 1;
 543     }
 544     else
 545     {
 546         return 0;
 547     }
 548 }
 549
 550 ### isPresent( $file )
 551 #
 552 # given a file, return true if that file exists.  return false otherwise.
 553 #
 554
 555 sub isPresent
 556 {
 557     my($file) = @_;
 558
 559     if ( -e $file )
 560     {
 561         return 1;
 562     }
 563     else
 564     {
 565         return 0;
 566     }
 567 }
 568
 569 ### makeConfDir( )
 570 #
 571 # make the gsi-openssh configuration directory if it doesn't already exist.
 572 #
 573
 574 sub makeConfDir
 575 {
 576     if ( isPresent($sysconfdir) )
 577     {
 578         if ( -d $sysconfdir )
 579         {
 580             return;
 581         }
 582
 583         die("${sysconfdir} already exists and is not a directory!\n");
 584     }
 585
 586     print "Could not find ${sysconfdir} directory... creating.\n";
 587     action("mkdir -p $sysconfdir");
 588
 589     return;
 590 }
 591
 592 ### determineKeys( )
 593 #
 594 # based on a set of key types, triage them to determine if for each key type, that
 595 # key type should be copied from the main ssh configuration directory, or if it
 596 # should be generated using ssh-keygen.
 597 #
 598
 599 sub determineKeys
 600 {
 601     my($keyhash, $keylist);
 602     my($count);
 603
 604     #
 605     # initialize our variables
 606     #
 607
 608     $count = 0;
 609
 610     $keyhash = {};
 611     $keyhash->{gen} = [];   # a list of keytypes to generate
 612     $keyhash->{copy} = [];  # a list of files to copy from the
 613
 614     $genlist = $keyhash->{gen};
 615     $copylist = $keyhash->{copy};
 616
 617     #
 618     # loop over our keytypes and determine what we need to do for each of them
 619     #
 620
 621     for my $keytype (keys %$keyfiles)
 622     {
 623         $basekeyfile = $keyfiles->{$keytype};
 624
 625         #
 626         # if the key's are already present, we don't need to bother with this rigamarole
 627         #
 628
 629         $gkeyfile = "$sysconfdir/$basekeyfile";
 630         $gpubkeyfile = "$sysconfdir/$basekeyfile.pub";
 631
 632         if ( isPresent($gkeyfile) && isPresent($gpubkeyfile) )
 633         {
 634             if ( isForced() )
 635             {
 636                 if ( isWritable("$sysconfdir/$basekeyfile") && isWritable("$sysconfdir/$basekeyfile.pub") )
 637                 {
 638                      action("rm $sysconfdir/$basekeyfile");
 639                      action("rm $sysconfdir/$basekeyfile.pub");
 640                 }
 641                 else
 642                 {
 643                      next;
 644                 }
 645             }
 646         }
 647
 648         #
 649         # if we can find a copy of the keys in /etc/ssh, we'll copy them to the user's
 650         # globus location
 651         #
 652
 653         $mainkeyfile = "$localsshdir/$basekeyfile";
 654         $mainpubkeyfile = "$localsshdir/$basekeyfile.pub";
 655
 656         if ( isReadable($mainkeyfile) && isReadable($mainpubkeyfile) )
 657         {
 658             push(@$copylist, $basekeyfile);
 659             $count++;
 660             next;
 661         }
 662
 663         #
 664         # otherwise, we need to generate the key
 665         #
 666
 667         push(@$genlist, $keytype);
 668         $count++;
 669     }
 670
 671     return $keyhash;
 672 }
 673
 674 ### runKeyGen( $gen_keys )
 675 #
 676 # given a set of key types, generate private and public keys for that key type and
 677 # place them in the gsi-openssh configuration directory.
 678 #
 679
 680 sub runKeyGen
 681 {
 682     my($gen_keys) = @_;
 683     my $keygen = "$bindir/ssh-keygen";
 684
 685     if (@$gen_keys && -x $keygen)
 686     {
 687         print "Generating ssh host keys...\n";
 688
 689         for my $k (@$gen_keys)
 690         {
 691             $keyfile = $keyfiles->{$k};
 692
 693             if ( !isPresent("$sysconfdir/$keyfile") )
 694             {
 695                 action("$bindir/ssh-keygen -t $k -f $sysconfdir/$keyfile -N \"\"");
 696             }
 697         }
 698     }
 699
 700     return 0;
 701 }
 702
 703 ### copySSHDConfigFile( )
 704 #
 705 # this subroutine 'edits' the paths in sshd_config to suit them to the current environment
 706 # in which the setup script is being run.
 707 #
 708
 709 sub copySSHDConfigFile
 710 {
 711     my($fileInput, $fileOutput);
 712     my($mode, $uid, $gid);
 713     my($line, $newline);
 714
 715     print "Fixing paths in sshd_config...\n";
 716
 717     $fileInput = "$setupdir/sshd_config.in";
 718     $fileOutput = "$sysconfdir/sshd_config";
 719
 720     #
 721     # verify that we are prepared to work with $fileInput
 722     #
 723
 724     if ( !isReadable($fileInput) )
 725     {
 726         printf("Cannot read $fileInput... skipping.\n");
 727         return;
 728     }
 729
 730     #
 731     # verify that we are prepared to work with $fileOuput
 732     #
 733
 734     if ( !prepareFileWrite($fileOutput) )
 735     {
 736         return;
 737     }
 738
 739     #
 740     # Grab the current mode/uid/gid for use later
 741     #
 742
 743     $mode = (stat($fileInput))[2];
 744     $uid = (stat($fileInput))[4];
 745     $gid = (stat($fileInput))[5];
 746
 747     #
 748     # Open the files for reading and writing, and loop over the input's contents
 749     #
 750
 751     open(IN, "<$fileInput") || die ("$0: input file $fileInput missing!\n");
 752     open(OUT, ">$fileOutput") || die ("$0: unable to open output file $fileOutput!\n");
 753
 754     while (<IN>)
 755     {
 756         #
 757         # sorry for the whacky regex, but i need to verify a whole line
 758         #
 759
 760         $line = $_;
 761         if ( $line =~ /^\s*Subsystem\s+sftp\s+\S+\s*$/ )
 762         {
 763             $line = "Subsystem\tsftp\t$gpath/libexec/sftp-server\n";
 764             $line =~ s:/+:/:g;
 765         }
 766         elsif ( $line =~ /^\s*PidFile.*$/ )
 767         {
 768             $line = "PidFile\t$gpath/var/sshd.pid\n";
 769             $line =~ s:/+:/:g;
 770         }
 771         else
 772         {
 773             # do nothing
 774         }
 775
 776         print OUT "$line";
 777     } # while <IN>
 778
 779     close(OUT);
 780     close(IN);
 781
 782     #
 783     # An attempt to revert the new file back to the original file's
 784     # mode/uid/gid
 785     #
 786
 787     chmod($mode, $fileOutput);
 788     chown($uid, $gid, $fileOutput);
 789
 790     return 0;
 791 }
 792
 793 ### prepareFileWrite( $file )
 794 #
 795 # test $file to prepare for writing to it.
 796 #
 797
 798 sub prepareFileWrite
 799 {
 800     my($file) = @_;
 801
 802     if ( isPresent($file) )
 803     {
 804         printf("$file already exists... ");
 805
 806         if ( isForced() )
 807         {
 808             if ( isWritable($file) )
 809             {
 810                 printf("removing.\n");
 811                 action("rm $file");
 812                 return 1;
 813             }
 814             else
 815             {
 816                 printf("not writable -- skipping.\n");
 817                 return 0;
 818             }
 819         }
 820         else
 821         {
 822             printf("skipping.\n");
 823             return 0;
 824         }
 825     }
 826
 827     return 1;
 828 }
 829
 830 ### copyConfigFiles( )
 831 #
 832 # subroutine that copies some extra config files to their proper location in
 833 # $GLOBUS_LOCATION/etc/ssh.
 834 #
 835
 836 sub copyConfigFiles
 837 {
 838     #
 839     # copy the sshd_config file into the ssh configuration directory and alter
 840     # the paths in the file.
 841     #
 842
 843     copySSHDConfigFile();
 844
 845     #
 846     # do straight copies of the ssh_config and moduli files.
 847     #
 848
 849     printf("Copying ssh_config and moduli to their proper location...\n");
 850
 851     copyFile("$setupdir/ssh_config", "$sysconfdir/ssh_config");
 852     copyFile("$setupdir/moduli", "$sysconfdir/moduli");
 853
 854     #
 855     # copy and alter the SXXsshd script.
 856     #
 857
 858     copySXXScript("$setupdir/SXXsshd.in", "$sbindir/SXXsshd");
 859 }
 860
 861 ### copyFile( $src, $dest )
 862 #
 863 # copy the file pointed to by $src to the location specified by $dest.  in the
 864 # process observe the rules regarding when the '-force' flag was passed to us.
 865 #
 866
 867 sub copyFile
 868 {
 869     my($src, $dest) = @_;
 870
 871     if ( !isReadable($src) )
 872     {
 873         printf("$src is not readable... not creating $dest.\n");
 874         return;
 875     }
 876
 877     if ( !prepareFileWrite($dest) )
 878     {
 879         return;
 880     }
 881
 882     action("cp $src $dest");
 883 }
 884
 885 ### copySXXScript( $in, $out )
 886 #
 887 # parse the input file, substituting in place the value of GLOBUS_LOCATION, and
 888 # write the result to the output file.
 889 #
 890
 891 sub copySXXScript
 892 {
 893     my($in, $out) = @_;
 894
 895     if ( !isReadable($in) )
 896     {
 897         printf("$in is not readable... not creating $out.\n");
 898         return;
 899     }
 900
 901     if ( !prepareFileWrite($out) )
 902     {
 903         return;
 904     }
 905
 906     $data = readFile($in);
 907     $data =~ s|\@GLOBUS_LOCATION\@|$gpath|g;
 908     writeFile($out, $data);
 909     action("chmod 755 $out");
 910 }
 911
 912 ### readFile( $filename )
 913 #
 914 # reads and returns $filename's contents
 915 #
 916
 917 sub readFile
 918 {
 919     my($filename) = @_;
 920     my($data);
 921
 922     open(IN, "$filename") || die "Can't open '$filename': $!";
 923     $/ = undef;
 924     $data = <IN>;
 925     $/ = "\n";
 926     close(IN);
 927
 928     return $data;
 929 }
 930
 931 ### writeFile( $filename, $fileinput )
 932 #
 933 # create the inputs to the ssl program at $filename, appending the common name to the
 934 # stream in the process
 935 #
 936
 937 sub writeFile
 938 {
 939     my($filename, $fileinput) = @_;
 940
 941     #
 942     # test for a valid $filename
 943     #
 944
 945     if ( !defined($filename) || (length($filename) lt 1) )
 946     {
 947         die "Filename is undefined";
 948     }
 949
 950     #
 951     # verify that we are prepared to work with $filename
 952     #
 953
 954     if ( !prepareFileWrite($filename) )
 955     {
 956         return;
 957     }
 958
 959     #
 960     # write the output to $filename
 961     #
 962
 963     open(OUT, ">$filename");
 964     print OUT "$fileinput";
 965     close(OUT);
 966 }
 967
 968 ### action( $command )
 969 #
 970 # run $command within a proper system() command.
 971 #
 972
 973 sub action
 974 {
 975     my($command) = @_;
 976
 977     printf "$command\n";
 978
 979     my $result = system("LD_LIBRARY_PATH=\"$gpath/lib:\$LD_LIBRARY_PATH\"; $command 2>&1");
 980
 981     if (($result or $?) and $command !~ m!patch!)
 982     {
 983         die "ERROR: Unable to execute command: $!\n";
 984     }
 985 }
 986
 987 ### query_boolean( $query_text, $default )
 988 #
 989 # query the user with a string, and expect a response.  If the user hits
 990 # 'enter' instead of entering an input, then accept the default response.
 991 #
 992
 993 sub query_boolean
 994 {
 995     my($query_text, $default) = @_;
 996     my($nondefault, $foo, $bar);
 997
 998     #
 999     # Set $nondefault to the boolean opposite of $default.
1000     #
1001
1002     if ($default eq "n")
1003     {
1004         $nondefault = "y";
1005     }
1006     else
1007     {
1008         $nondefault = "n";
1009     }
1010
1011     print "${query_text} ";
1012     print "[$default] ";
1013
1014     $foo = <STDIN>;
1015     ($bar) = split //, $foo;
1016
1017     if ( grep(/\s/, $bar) )
1018     {
1019         # this is debatable.  all whitespace means 'default'
1020
1021         $bar = $default;
1022     }
1023     elsif ($bar ne $default)
1024     {
1025         # everything else means 'nondefault'.
1026
1027         $bar = $nondefault;
1028     }
1029     else
1030     {
1031         # extraneous step.  to get here, $bar should be eq to $default anyway.
1032
1033         $bar = $default;
1034     }
1035
1036     return $bar;
1037 }
1038
1039 ### absolutePath( $file )
1040 #
1041 # converts a given pathname into a canonical path using the abs_path function.
1042 #
1043
1044 sub absolutePath
1045 {
1046     my($file) = @_;
1047     my $home = $ENV{'HOME'};
1048     $file =~ s!~!$home!;
1049     my $startd = cwd();
1050     $file =~ s!^\./!$startd/!;
1051     $file = "$startd/$file" if $file !~ m!^\s*/!;
1052     $file = abs_path($file);
1053     return $file;
1054 }