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