source: locker/deploy/bin/onserver.pm @ 465

Last change on this file since 465 was 462, checked in by andersk, 15 years ago
Things that give me nightmares, volume 462.
  • Property svn:executable set to *
File size: 3.2 KB
Line 
1package onserver;
2use strict;
3use Exporter;
4use Sys::Hostname;
5use File::Spec::Functions;
6use File::Basename;
7use Socket;
8use Cwd qw(abs_path);
9use POSIX qw(strftime);
10our @ISA = qw(Exporter);
11our @EXPORT = qw(setup totmp print_login_info press_enter $server $tmp $USER $HOME $sname $deploy $addrend $admin_username $requires_sql $addrlast $sqlhost $sqluser $sqlpass $sqldb $sqldbcurl $admin_password $scriptsdev $human);
12
13our $server = "scripts.mit.edu";
14
15our ($tmp, $USER, $HOME, $sname, $deploy, $addrend, $admin_username, $requires_sql, $addrlast, $sqlhost, $sqluser, $sqlpass, $sqldb, $sqldbcurl, $admin_password, $scriptsdev, $human);
16
17$tmp = ".scripts-tmp";
18sub totmp {
19  open(FILE, ">$tmp");
20  print FILE $_[0];
21  close(FILE);
22}
23
24sub print_login_info {
25  print "\nYou will be able to log in to $sname using the following:\n";
26  print "  username: $admin_username\n";
27  print "  password: $admin_password\n";
28}
29
30sub getclienthostname {
31    if (my $sshclient = $ENV{"SSH_CLIENT"}) {
32        my ($clientip) = split(' ', $sshclient);
33        my $hostname = gethostbyaddr(inet_aton($clientip), AF_INET);
34        return $hostname || $clientip;
35    } else {
36        return hostname();
37    }
38}
39
40sub press_enter {
41  local $/ = "\n";
42  print "Press [enter] to continue with the install.";
43  my $enter = <STDIN>; 
44}
45
46sub setup {
47  $ENV{PATH} = '/bin:/usr/bin';
48  $USER = $ENV{USER};
49  $HOME = $ENV{HOME};
50 
51  ($sname, $deploy, $addrend, $admin_username, $requires_sql, $scriptsdev, $human) = @ARGV;
52  chdir "$HOME/web_scripts/$addrend";
53 
54  if($addrend =~ /^(.*)\/$/) {
55    $addrend = $1;
56  }
57  ($addrlast) = ($addrend =~ /([^\/]*)$/);
58 
59  if($requires_sql) {
60    print "\nCreating SQL database for $sname...\n";
61   
62    my $getpwd=system("/mit/scripts/sql/bin$scriptsdev/get-password");
63    ($sqlhost, $sqluser, $sqlpass) = split(/\s/, $getpwd);
64   
65    $sqldb=system("/mit/scripts/sql/bin$scriptsdev/get-next-database", $addrlast);
66    $sqldb=system("/mit/scripts/sql/bin$scriptsdev/create-database", $sqldb);
67    if($sqldb eq "") {
68      print "\nERROR:\n";
69      print "Your SQL account failed to create a SQL database.\n";
70      print "You should log in at http://sql.mit.edu to check whether\n";
71      print "your SQL account is at its database limit or its storage limit.\n";
72      print "If you cannot determine the cause of the problem, please\n";
73      print "feel free to contact sql\@mit.edu for assistance.\n";
74      open FAILED, ">.failed";
75      close FAILED;
76      exit 1;
77    }
78    $sqldbcurl = $sqldb;
79    $sqldbcurl =~ s/\+/\%2B/;
80  }
81 
82  if(-e "$HOME/web_scripts/$addrend/.admin") { 
83    open ADMIN, "<$HOME/web_scripts/$addrend/.admin";
84    $admin_password=<ADMIN>;
85    chomp($admin_password);
86    close ADMIN;
87    unlink "$HOME/web_scripts/$addrend/.admin";
88  } 
89
90  print "\nConfiguring $sname...\n";
91 
92  open(VERSION, ">.scripts-version") or die "Can't write scripts-version file: $!\n";
93  print VERSION strftime("%F %T %z\n", localtime);
94  print VERSION $ENV{'USER'}, '@', getclienthostname(), "\n";
95  my $tarball = abs_path("/mit/scripts/deploy$scriptsdev/$deploy.tar.gz");
96  print VERSION $tarball, "\n";
97  $tarball =~ s|/deploydev/|/deploy/|;
98  print VERSION dirname($tarball), "\n";
99  close(VERSION);
100
101  select STDOUT;
102  $| = 1; # STDOUT is *hot*!
103}
Note: See TracBrowser for help on using the repository browser.