]> andersk Git - gssapi-openssh.git/blame - setup/setup-openssh.pl
o Bump to version 2.6.
[gssapi-openssh.git] / setup / setup-openssh.pl
CommitLineData
7a7884ad 1#!/usr/bin/perl
20d3226a 2#
5002372c 3# setup-openssh.pl
4#
95f536ac 5# Adapts the installed gsi-openssh environment to the current machine,
5002372c 6# performing actions that originally occurred during the package's
7# 'make install' phase.
701aa556 8#
1eab725d 9# Send comments/fixes/suggestions to:
10# Chase Phillips <cphillip@ncsa.uiuc.edu>
701aa556 11#
20d3226a 12
7e12c9a7 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
4f276ad7 24$gpath = $ENV{GLOBUS_LOCATION};
ad71c979 25if (!defined($gpath))
26{
21e62476 27 exitDie("ERROR: GLOBUS_LOCATION needs to be set before running this script!\n");
ad71c979 28}
29
7a7884ad 30#
31# Include standard modules
32#
33
34use Getopt::Long;
35use Cwd;
36use Cwd 'abs_path';
37
8b73e3d0 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";
44if (length($oldldpath) > 0)
45{
46 $newldpath .= ":$oldldpath";
47}
48$ENV{LD_LIBRARY_PATH} = "$newldpath";
49
ad71c979 50#
51# i'm including this because other perl scripts in the gpt setup directories
52# do so
53#
54
7e12c9a7 55if (defined($gptpath))
56{
57 @INC = (@INC, "$gptpath/lib/perl", "$gpath/lib/perl");
58}
59else
60{
61 @INC = (@INC, "$gpath/lib/perl");
62}
ad71c979 63
4f276ad7 64require Grid::GPT::Setup;
65
7a7884ad 66#
67# script-centred variable initialization
68#
69
ad71c979 70my $globusdir = $gpath;
ad71c979 71my $myname = "setup-openssh.pl";
72
20d3226a 73#
74# Set up path prefixes for use in the path translations
75#
76
d0a1bda7 77$prefix = ${globusdir};
78$exec_prefix = "${prefix}";
79$bindir = "${exec_prefix}/bin";
9cc10d0e 80$sbindir = "${exec_prefix}/sbin";
95f536ac 81$sysconfdir = "$prefix/etc/ssh";
82$localsshdir = "/etc/ssh";
20bb6dc8 83$setupdir = "$prefix/setup/gsi_openssh_setup";
e9ec5455 84
7a7884ad 85#
86# standard key types and their root file name mappings
87#
88
95f536ac 89my $keyfiles = {
90 "dsa" => "ssh_host_dsa_key",
91 "rsa" => "ssh_host_rsa_key",
92 "rsa1" => "ssh_host_key",
93 };
823981ba 94
7a7884ad 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
571ab952 100my($prompt, $force, $verbose);
7a7884ad 101
bf1ee591 102$prompt = 1;
15ff71ab 103$verbose = 0;
bf1ee591 104
7a7884ad 105GetOptions(
571ab952 106 'prompt!' => \$prompt,
7a7884ad 107 'force' => \$force,
108 'verbose' => \$verbose,
109 ) or pod2usage(2);
110
2c034b75 111#
112# miscellaneous initialization functions
113#
114
115setPrivilegeSeparation(0);
116
7a7884ad 117#
118# main execution. This should find its way into a subroutine at some future
119# point.
120#
121
15ff71ab 122debug0("$myname: Configuring package 'gsi_openssh'...\n");
123debug0("---------------------------------------------------------------------\n");
4f3224f2 124
125makeConfDir();
614e6d8b 126copyPRNGFile();
4f3224f2 127$keyhash = determineKeys();
128runKeyGen($keyhash->{gen});
129copyKeyFiles($keyhash->{copy});
4f3224f2 130copyConfigFiles();
4f3224f2 131
132my $metadata = new Grid::GPT::Setup(package_name => "gsi_openssh_setup");
133
134$metadata->finish();
135
15ff71ab 136debug1("\n");
137debug0("Notes:\n\n");
138
139if ( getPrivilegeSeparation() )
b48c75c0 140{
15ff71ab 141 debug0(" o Privilege separation is on.\n");
b48c75c0 142}
15ff71ab 143elsif ( !getPrivilegeSeparation() )
571ab952 144{
15ff71ab 145 debug0(" o Privilege separation is off.\n");
571ab952 146}
ff3b2ddb 147
15ff71ab 148debug0(" o GSI-OpenSSH website is <http://grid.ncsa.uiuc.edu/ssh/>.\n");
149debug0("---------------------------------------------------------------------\n");
150debug0("$myname: Finished configuring package 'gsi_openssh'.\n");
4f3224f2 151
152exit;
153
154#
155# subroutines
156#
157
7a7884ad 158### initPRNGHash( )
159#
160# initialize the PRNG pathname hash
161#
162
163sub 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
15ff71ab 186 debug1("Determining paths for PRNG commands...\n");
7a7884ad 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
199sub 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
230sub 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
243sub copyPRNGFile
244{
245 my($fileInput, $fileOutput);
246 my($mode, $uid, $gid);
247 my($data);
248
64545db1 249 if ( isPresent("$sysconfdir/ssh_prng_cmds") && !isForced() )
7a7884ad 250 {
15ff71ab 251 debug1("ssh_prng_cmds found and not forced. Not installing ssh_prng_cmds...\n");
7a7884ad 252 return;
253 }
254
255 initPRNGHash();
256
15ff71ab 257 debug1("Fixing paths in ssh_prng_cmds...\n");
7a7884ad 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 {
15ff71ab 268 debug1("Cannot read $fileInput... skipping.\n");
7a7884ad 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
318sub 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
340sub 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
362sub 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
374sub 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
386sub 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
398sub 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
411sub 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
4f3224f2 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
95f536ac 434sub copyKeyFiles
e9ec5455 435{
95f536ac 436 my($copylist) = @_;
437 my($regex, $basename);
e9ec5455 438
712b003f 439 if (@$copylist)
e9ec5455 440 {
15ff71ab 441 debug1("Copying ssh host keys...\n");
e9ec5455 442
712b003f 443 for my $f (@$copylist)
95f536ac 444 {
712b003f 445 $f =~ s:/+:/:g;
446
447 if (length($f) > 0)
448 {
449 $keyfile = "$f";
450 $pubkeyfile = "$f.pub";
95f536ac 451
7a7884ad 452 copyFile("$localsshdir/$keyfile", "$sysconfdir/$keyfile");
453 copyFile("$localsshdir/$pubkeyfile", "$sysconfdir/$pubkeyfile");
712b003f 454 }
95f536ac 455 }
e9ec5455 456 }
e9ec5455 457}
458
7a7884ad 459### isForced( )
460#
461# return true if the user passed in the force flag. return false otherwise.
462#
463
464sub isForced
465{
466 if ( defined($force) && $force )
467 {
468 return 1;
469 }
470 else
471 {
472 return 0;
473 }
474}
475
4f3224f2 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
95f536ac 482sub isReadable
1a1f62a4 483{
95f536ac 484 my($file) = @_;
1a1f62a4 485
95f536ac 486 if ( ( -e $file ) && ( -r $file ) )
1a1f62a4 487 {
95f536ac 488 return 1;
1a1f62a4 489 }
823981ba 490 else
1a1f62a4 491 {
95f536ac 492 return 0;
ac083f7a 493 }
1a1f62a4 494}
495
7a7884ad 496### isExecutable( $file )
497#
498# return true if $file is executable. return false otherwise.
499#
500
501sub 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
521sub 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
4f3224f2 535### isPresent( $file )
536#
537# given a file, return true if that file exists. return false otherwise.
538#
539
712b003f 540sub isPresent
541{
542 my($file) = @_;
543
544 if ( -e $file )
545 {
546 return 1;
547 }
548 else
549 {
550 return 0;
551 }
552}
553
c096bf39 554### makeConfDir( )
555#
556# make the gsi-openssh configuration directory if it doesn't already exist.
557#
558
559sub makeConfDir
560{
561 if ( isPresent($sysconfdir) )
562 {
563 if ( -d $sysconfdir )
564 {
565 return;
566 }
567
15ff71ab 568 debug1("${sysconfdir} already exists and is not a directory!\n");
74d5d582 569 exit;
c096bf39 570 }
571
15ff71ab 572 debug1("Could not find ${sysconfdir} directory... creating.\n");
c096bf39 573 action("mkdir -p $sysconfdir");
574
575 return;
576}
577
4f3224f2 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
95f536ac 585sub determineKeys
823981ba 586{
95f536ac 587 my($keyhash, $keylist);
588 my($count);
823981ba 589
712b003f 590 #
591 # initialize our variables
592 #
593
95f536ac 594 $count = 0;
823981ba 595
95f536ac 596 $keyhash = {};
597 $keyhash->{gen} = []; # a list of keytypes to generate
598 $keyhash->{copy} = []; # a list of files to copy from the
712b003f 599
95f536ac 600 $genlist = $keyhash->{gen};
601 $copylist = $keyhash->{copy};
e9ec5455 602
712b003f 603 #
604 # loop over our keytypes and determine what we need to do for each of them
605 #
606
95f536ac 607 for my $keytype (keys %$keyfiles)
1a1f62a4 608 {
95f536ac 609 $basekeyfile = $keyfiles->{$keytype};
1a1f62a4 610
712b003f 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) )
95f536ac 619 {
7a7884ad 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 }
95f536ac 632 }
1a1f62a4 633
712b003f 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) )
95f536ac 643 {
712b003f 644 push(@$copylist, $basekeyfile);
95f536ac 645 $count++;
712b003f 646 next;
95f536ac 647 }
712b003f 648
649 #
650 # otherwise, we need to generate the key
651 #
652
653 push(@$genlist, $keytype);
654 $count++;
1a1f62a4 655 }
656
95f536ac 657 return $keyhash;
658}
659
4f3224f2 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
95f536ac 666sub runKeyGen
667{
668 my($gen_keys) = @_;
ce935927 669 my $keygen = "$bindir/ssh-keygen";
95f536ac 670
ce935927 671 if (@$gen_keys && -x $keygen)
1a1f62a4 672 {
15ff71ab 673 debug1("Generating ssh host keys...\n");
712b003f 674
675 for my $k (@$gen_keys)
676 {
677 $keyfile = $keyfiles->{$k};
95f536ac 678
7a7884ad 679 if ( !isPresent("$sysconfdir/$keyfile") )
680 {
681 action("$bindir/ssh-keygen -t $k -f $sysconfdir/$keyfile -N \"\"");
682 }
712b003f 683 }
1a1f62a4 684 }
685
686 return 0;
687}
688
7a7884ad 689### copySSHDConfigFile( )
5b105785 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
7a7884ad 695sub copySSHDConfigFile
20d3226a 696{
5b105785 697 my($fileInput, $fileOutput);
698 my($mode, $uid, $gid);
699 my($line, $newline);
b48c75c0 700 my($privsep_enabled);
823981ba 701
15ff71ab 702 debug1("Fixing paths in sshd_config...\n");
95f536ac 703
5b105785 704 $fileInput = "$setupdir/sshd_config.in";
705 $fileOutput = "$sysconfdir/sshd_config";
95f536ac 706
7a7884ad 707 #
708 # verify that we are prepared to work with $fileInput
709 #
710
711 if ( !isReadable($fileInput) )
95f536ac 712 {
15ff71ab 713 debug1("Cannot read $fileInput... skipping.\n");
7a7884ad 714 return;
5b105785 715 }
716
7a7884ad 717 #
718 # verify that we are prepared to work with $fileOuput
719 #
720
721 if ( !prepareFileWrite($fileOutput) )
5b105785 722 {
7a7884ad 723 return;
95f536ac 724 }
e9ec5455 725
b48c75c0 726 #
727 # check to see whether we should enable privilege separation
728 #
729
8c2b2cf1 730 if ( userExists("sshd") && ( -d "/var/empty" ) && ( getOwnerID("/var/empty") eq 0 ) )
b48c75c0 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
20d3226a 748 #
95f536ac 749 # Grab the current mode/uid/gid for use later
20d3226a 750 #
751
5b105785 752 $mode = (stat($fileInput))[2];
753 $uid = (stat($fileInput))[4];
754 $gid = (stat($fileInput))[5];
20d3226a 755
20d3226a 756 #
5b105785 757 # Open the files for reading and writing, and loop over the input's contents
20d3226a 758 #
759
b48c75c0 760 $data = readFile($fileInput);
20d3226a 761
fb6517a6 762 # #
763 # # alter the PidFile config
764 # #
765 #
766 # $text = "PidFile\t$gpath/var/sshd.pid";
767 # $data =~ s:^[\s|#]*PidFile.*$:$text:gm;
eb4172f6 768
b48c75c0 769 #
770 # set the sftp directive
771 #
7c96a399 772
b84327f8 773 $text = "Subsystem\tsftp\t$gpath/libexec/sftp-server";
b48c75c0 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);
7c96a399 788
95f536ac 789 #
790 # An attempt to revert the new file back to the original file's
791 # mode/uid/gid
792 #
7e12c9a7 793
5b105785 794 chmod($mode, $fileOutput);
795 chown($uid, $gid, $fileOutput);
20d3226a 796
797 return 0;
798}
799
b48c75c0 800### setPrivilegeSeparation( $value )
801#
802# set the privilege separation variable to $value
803#
804
805sub 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
817sub getPrivilegeSeparation
818{
819 return $privsep;
820}
821
7a7884ad 822### prepareFileWrite( $file )
823#
824# test $file to prepare for writing to it.
825#
826
827sub prepareFileWrite
828{
829 my($file) = @_;
830
831 if ( isPresent($file) )
832 {
15ff71ab 833 debug1("$file already exists... ");
7a7884ad 834
835 if ( isForced() )
836 {
837 if ( isWritable($file) )
838 {
15ff71ab 839 debug1("removing.\n");
7a7884ad 840 action("rm $file");
841 return 1;
842 }
843 else
844 {
15ff71ab 845 debug1("not writable -- skipping.\n");
7a7884ad 846 return 0;
847 }
848 }
849 else
850 {
15ff71ab 851 debug1("skipping.\n");
7a7884ad 852 return 0;
853 }
854 }
855
856 return 1;
857}
858
5b105785 859### copyConfigFiles( )
860#
861# subroutine that copies some extra config files to their proper location in
862# $GLOBUS_LOCATION/etc/ssh.
863#
864
865sub copyConfigFiles
866{
7a7884ad 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
15ff71ab 878 debug1("Copying ssh_config and moduli to their proper location...\n");
7a7884ad 879
880 copyFile("$setupdir/ssh_config", "$sysconfdir/ssh_config");
881 copyFile("$setupdir/moduli", "$sysconfdir/moduli");
5b105785 882
7a7884ad 883 #
884 # copy and alter the SXXsshd script.
885 #
886
887 copySXXScript("$setupdir/SXXsshd.in", "$sbindir/SXXsshd");
5b105785 888}
889
7a7884ad 890### copyFile( $src, $dest )
4f3224f2 891#
7a7884ad 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.
4f3224f2 894#
895
7a7884ad 896sub copyFile
a26c150d 897{
7a7884ad 898 my($src, $dest) = @_;
d58b3a33 899
7a7884ad 900 if ( !isReadable($src) )
20bb6dc8 901 {
15ff71ab 902 debug1("$src is not readable... not creating $dest.\n");
7a7884ad 903 return;
20bb6dc8 904 }
7a7884ad 905
906 if ( !prepareFileWrite($dest) )
907 {
908 return;
909 }
910
911 action("cp $src $dest");
d58b3a33 912}
913
7a7884ad 914### copySXXScript( $in, $out )
4f3224f2 915#
7a7884ad 916# parse the input file, substituting in place the value of GLOBUS_LOCATION, and
917# write the result to the output file.
4f3224f2 918#
919
7a7884ad 920sub copySXXScript
d58b3a33 921{
7a7884ad 922 my($in, $out) = @_;
b1282c82 923 my($tmpgpath);
7a7884ad 924
925 if ( !isReadable($in) )
926 {
15ff71ab 927 debug1("$in is not readable... not creating $out.\n");
7a7884ad 928 return;
929 }
930
931 if ( !prepareFileWrite($out) )
932 {
933 return;
934 }
935
b1282c82 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
7a7884ad 948 $data = readFile($in);
b1282c82 949 $data =~ s|\@GLOBUS_LOCATION\@|$tmpgpath|g;
7a7884ad 950 writeFile($out, $data);
951 action("chmod 755 $out");
a26c150d 952}
953
954### readFile( $filename )
955#
956# reads and returns $filename's contents
957#
958
959sub readFile
960{
7a7884ad 961 my($filename) = @_;
962 my($data);
a26c150d 963
21e62476 964 open(IN, "$filename") || exitDie("ERROR: Can't open '$filename': $!\n");
a26c150d 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
979sub writeFile
980{
7a7884ad 981 my($filename, $fileinput) = @_;
a26c150d 982
983 #
984 # test for a valid $filename
985 #
986
987 if ( !defined($filename) || (length($filename) lt 1) )
988 {
21e62476 989 exitDie("ERROR: Filename is undefined!\n");
a26c150d 990 }
991
7a7884ad 992 #
993 # verify that we are prepared to work with $filename
994 #
995
996 if ( !prepareFileWrite($filename) )
a26c150d 997 {
7a7884ad 998 return;
a26c150d 999 }
1000
1001 #
1002 # write the output to $filename
1003 #
1004
1005 open(OUT, ">$filename");
1006 print OUT "$fileinput";
1007 close(OUT);
1008}
1009
15ff71ab 1010### debug1( $arg1, $arg2 )
1011#
1012# Print out a debugging message at level 1.
1013#
1014
1015sub 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
1025sub 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
1036sub 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
7a7884ad 1051### action( $command )
ac083f7a 1052#
7a7884ad 1053# run $command within a proper system() command.
ac083f7a 1054#
1055
1056sub action
1057{
7a7884ad 1058 my($command) = @_;
ac083f7a 1059
15ff71ab 1060 debug1("$command\n");
ac083f7a 1061
15ff71ab 1062 my $result = system("LD_LIBRARY_PATH=\"$gpath/lib:\$LD_LIBRARY_PATH\"; $command >/dev/null 2>&1");
ac083f7a 1063
1064 if (($result or $?) and $command !~ m!patch!)
1065 {
21e62476 1066 exitDie("ERROR: Unable to execute command: $!\n");
ac083f7a 1067 }
1068}
1069
74d5d582 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
1076sub exitDie
1077{
1078 my($error) = @_;
1079
1080 print $error;
1081 exit;
1082}
1083
7a7884ad 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
ac083f7a 1090sub query_boolean
1091{
7a7884ad 1092 my($query_text, $default) = @_;
1093 my($nondefault, $foo, $bar);
ac083f7a 1094
bf1ee591 1095 if ( !$prompt )
571ab952 1096 {
1097 print "Prompt suppressed. Continuing...\n";
1098 return "y";
1099 }
1100
ac083f7a 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
e9ec5455 1117 $foo = <STDIN>;
1118 ($bar) = split //, $foo;
1119
e9d69a89 1120 if ( grep(/\s/, $bar) )
ac083f7a 1121 {
e9d69a89 1122 # this is debatable. all whitespace means 'default'
1123
1124 $bar = $default;
1125 }
be47d94e 1126 elsif ($bar eq '')
1127 {
1128 $bar = $default;
1129 }
e9d69a89 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
e9ec5455 1140 $bar = $default;
ac083f7a 1141 }
1142
e9ec5455 1143 return $bar;
ac083f7a 1144}
c096bf39 1145
1146### absolutePath( $file )
1147#
1148# converts a given pathname into a canonical path using the abs_path function.
1149#
1150
1151sub 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}
b48c75c0 1162
8c2b2cf1 1163### getOwnerID( $file )
1164#
1165# return the uid containing the owner ID of the given file.
1166#
1167
1168sub 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
b48c75c0 1182### getMode( $file )
1183#
1184# return a string containing the mode of the given file.
1185#
1186
1187sub 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
1217sub 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}
This page took 1.001327 seconds and 5 git commands to generate.