source: trunk/locker/deploy/bin/onserver_star.pm

Last change on this file was 1103, checked in by mitchb, 13 years ago
Uncommitted scriptsstar changes from the locker
File size: 4.2 KB
Line 
1package onserver_star;
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);
10use LWP::UserAgent;
11use URI;
12our @ISA = qw(Exporter);
13our @EXPORT = qw(setup totmp fetch_uri print_login_info press_enter $server $tmp $USER $HOME $sname $deploy $addrend $base_uri $ua $admin_username $requires_sql $addrlast $sqlhost $sqluser $sqlpass $sqldb $admin_password $scriptsdev $human $email);
14
15our $server = "scripts.mit.edu";
16
17our ($tmp, $USER, $HOME, $sname, $deploy, $addrend, $base_uri, $ua, $admin_username, $requires_sql, $addrlast, $sqlhost, $sqluser, $sqlpass, $sqldb, $admin_password, $scriptsdev, $human, $email);
18
19$tmp = ".scripts-tmp";
20sub totmp {
21  open(FILE, ">$tmp");
22  print FILE $_[0];
23  close(FILE);
24}
25
26$ua = LWP::UserAgent->new;
27push @{$ua->requests_redirectable}, 'POST';
28
29sub fetch_uri {
30    my ($uri, $get, $post) = @_;
31    my $u = URI->new($uri);
32    my $req;
33    if (defined $post) {
34        $u->query_form($post);
35        my $content = $u->query;
36        $u->query_form($get);
37        $req = HTTP::Request->new(POST => $u->abs($base_uri));
38        $req->content_type('application/x-www-form-urlencoded');
39        $req->content($content);
40    } else {
41        $u->query_form($get) if (defined $get);
42        $req = HTTP::Request->new(GET => $u->abs($base_uri));
43    }
44    my $res = $ua->request($req);
45    if ($res->is_success) {
46        return $res->content;
47    } else {
48        print STDERR "Error fetching configuration page: ", $res->status_line, "\n";
49        return undef;
50    }
51}
52
53sub print_login_info {
54  print "\nYou will be able to log in to $sname using the following:\n";
55  print "  username: $admin_username\n";
56  print "  password: $admin_password\n";
57}
58
59sub getclienthostname {
60    if (my $sshclient = $ENV{"SSH_CLIENT"}) {
61        my ($clientip) = split(' ', $sshclient);
62        my $hostname = gethostbyaddr(inet_aton($clientip), AF_INET);
63        return $hostname || $clientip;
64    } else {
65        return hostname();
66    }
67}
68
69sub press_enter {
70  local $/ = "\n";
71  print "Press [enter] to continue with the install.";
72  my $enter = <STDIN>; 
73}
74
75sub setup {
76  $ENV{PATH} = '/bin:/usr/bin';
77  $USER = $ENV{USER};
78  $HOME = $ENV{HOME};
79 
80  ($sname, $deploy, $addrend, $admin_username, $requires_sql, $scriptsdev, $human) = @ARGV;
81  chdir "$HOME/web_scripts/$addrend";
82  $email = "$human\@mit.edu";
83 
84  if($addrend =~ /^(.*)\/$/) {
85    $addrend = $1;
86  }
87  ($addrlast) = ($addrend =~ /([^\/]*)$/);
88 
89  $base_uri = "http://$USER.$server/$addrend/";
90 
91  if($requires_sql) {
92    print "\nCreating SQL database for $sname...\n";
93   
94    open GETPWD, '-|', "/mit/scripts/sql/bin$scriptsdev/get-password";
95    ($sqlhost, $sqluser, $sqlpass) = split(/\s/, <GETPWD>);
96    close GETPWD;
97    open SQLDB, '-|', "/mit/scripts/sql/bin$scriptsdev/get-next-database", $addrlast;
98    $sqldb = <SQLDB>;
99    close SQLDB;
100    open SQLDB, '-|', "/mit/scripts/sql/bin$scriptsdev/create-database", $sqldb;
101    $sqldb = <SQLDB>;
102    close SQLDB;
103    if($sqldb eq "") {
104      print "\nERROR:\n";
105      print "Your SQL account failed to create a SQL database.\n";
106      print "You should log in at http://sql.mit.edu to check whether\n";
107      print "your SQL account is at its database limit or its storage limit.\n";
108      print "If you cannot determine the cause of the problem, please\n";
109      print "feel free to contact sql\@mit.edu for assistance.\n";
110      open FAILED, ">.failed";
111      close FAILED;
112      exit 1;
113    }
114  }
115 
116  if(-e "$HOME/web_scripts/$addrend/.admin") { 
117    open ADMIN, "<$HOME/web_scripts/$addrend/.admin";
118    $admin_password=<ADMIN>;
119    chomp($admin_password);
120    close ADMIN;
121    unlink "$HOME/web_scripts/$addrend/.admin";
122  } 
123
124  print "\nConfiguring $sname...\n";
125  if($requires_sql) {
126    print "A copy of ${USER}'s SQL login info will be placed in\n/mit/$USER/web_scripts/$addrend.\n";
127  }
128 
129  open(VERSION, ">.scripts-version") or die "Can't write scripts-version file: $!\n";
130  print VERSION strftime("%F %T %z\n", localtime);
131  print VERSION $ENV{'USER'}, '@', getclienthostname(), "\n";
132  my $tarball = abs_path("/mit/scripts/deploy$scriptsdev/$deploy.tar.gz");
133  print VERSION $tarball, "\n";
134  $tarball =~ s|/deploydev/|/deploy/|;
135  print VERSION dirname($tarball), "\n";
136  close(VERSION);
137
138  select STDOUT;
139  $| = 1; # STDOUT is *hot*!
140}
141
1421;
Note: See TracBrowser for help on using the repository browser.