135 lines
3.9 KiB
Perl
Executable File
135 lines
3.9 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
use diagnostics;
|
|
|
|
use File::Basename qw(basename);
|
|
use Net::OpenSSH;
|
|
use DateTime;
|
|
use DBI;
|
|
|
|
use feature 'say';
|
|
|
|
sub remote {
|
|
my ( $ssh, @cmd ) = @_;
|
|
$ssh->system(@cmd);
|
|
$ssh->error and die "Remote command failed (@cmd): " . $ssh->error;
|
|
}
|
|
|
|
sub shell_quote {
|
|
my ($string) = @_;
|
|
$string =~ s/'/'"'"'/g;
|
|
return "'$string'";
|
|
}
|
|
|
|
my $date = DateTime->now->iso8601;
|
|
my $screen_name = 'smchurla_fail';
|
|
|
|
my $local_root = '/home/christoph/Notes/TU/MastersThesis/FailNix';
|
|
my $local_builds_dir = "$local_root/builds";
|
|
|
|
my $remote_host = 'mars'; # smchurla@mars.cs.tu-dortmund.de
|
|
my $remote_root = '/home/lab/smchurla/Documents/failnix';
|
|
my $remote_db_conf = "$remote_root/db.conf";
|
|
my $remote_builds_dir = "$remote_root/builds";
|
|
my $remote_runner = "$remote_root/scripts/runner.pl";
|
|
my $remote_log = "$remote_root/runner.log";
|
|
|
|
# The mars db is bound to local port 3306 over SSH.
|
|
# - This requires using the configured 'mars'
|
|
# remote_host instead of smchurla@mars
|
|
# or setting up another tunnel here
|
|
my $db_host = "127.0.0.1";
|
|
my $db_port = "3306";
|
|
my $db_user = "smchurla";
|
|
my $db_prefix = "$db_user\_$date";
|
|
|
|
# Database password
|
|
open( my $fhandle, '<', "$local_root/mars-db.conf" )
|
|
or die "Failed to read mars-db.conf: $!";
|
|
chomp( my $db_password = <$fhandle> );
|
|
close($fhandle);
|
|
|
|
# Initialize SSH connection
|
|
# - This connection also sets up the database tunnel
|
|
my $ssh = Net::OpenSSH->new(
|
|
$remote_host,
|
|
timeout => 30,
|
|
master_opts => [
|
|
-o => 'BatchMode=yes',
|
|
-o => 'StrictHostKeyChecking=accept-new',
|
|
],
|
|
);
|
|
$ssh->error and die 'SSH connection failed: ' . $ssh->error;
|
|
say 'Connected to mars.cs.tu-dortmund.de';
|
|
|
|
# TODO: Abort if old experiments are still on the server => meaning they're not archived
|
|
|
|
# Pull changes
|
|
# remote( $ssh, 'git', '-C', $remote_root, 'pull' ); # TODO: Requires auth
|
|
|
|
# Find new experiments
|
|
opendir( my $dhandle, $local_builds_dir )
|
|
or die "opendir($local_builds_dir): $!";
|
|
my @experiments = grep { $_ ne '.' && $_ ne '..' && -d "$local_builds_dir/$_" }
|
|
readdir($dhandle);
|
|
closedir($dhandle);
|
|
|
|
# Upload new experiments
|
|
remote( $ssh, 'mkdir', '-p', $remote_builds_dir );
|
|
foreach (@experiments) {
|
|
say " - Uploading $_ to $remote_builds_dir/$date\_$_...";
|
|
$ssh->scp_put(
|
|
{
|
|
recursive => 1,
|
|
copy_attrs => 1
|
|
},
|
|
"$local_builds_dir/$_",
|
|
"$remote_builds_dir/$date\_$_"
|
|
) or die "Failed to upload $_: " . $ssh->error;
|
|
}
|
|
|
|
# Initialize db connection
|
|
my $dbh = DBI->connect( "DBI:MariaDB:host=$db_host;port=$db_port",
|
|
$db_user, $db_password )
|
|
or die 'Failed to connect to database: ' . $DBI::errstr;
|
|
say 'Connected to database';
|
|
|
|
say 'Existing databases:';
|
|
my @db_names =
|
|
sort
|
|
map { s/DBI:MariaDB://r }
|
|
grep { !/information_schema|smchurla_ll/ } $dbh->data_sources();
|
|
foreach (@db_names) { say " - $_"; }
|
|
|
|
# Create dbs for new experiments
|
|
say 'Creating databases...';
|
|
foreach (@experiments) {
|
|
say " - Creating database $db_prefix\_$_...";
|
|
$dbh->do("create database `$db_prefix\_$_`")
|
|
or die "Failed to create database: " . $dbh->errstr;
|
|
}
|
|
|
|
# Kill old screen session (don't check success as a session might not exist)
|
|
# say "Killing previous screen session with name $screen_name";
|
|
# $ssh->system( "screen", "-XS", $screen_name, "quit" );
|
|
|
|
# Start new screen session
|
|
# my $invoke_runner =
|
|
# "cd " . shell_quote($remote_root) . " && perl " . shell_quote($remote_runner);
|
|
# say
|
|
# "Starting new screen session with name $screen_name and command $invoke_runner";
|
|
# remote( $ssh, "screen", "-dmS", $screen_name, "sh", "-lc",
|
|
# "exec $invoke_runner" );
|
|
|
|
remote( $ssh,
|
|
"nohup sh -c "
|
|
. shell_quote("cd $remote_root && perl $remote_runner") . " >"
|
|
. shell_quote($remote_log)
|
|
. " 2>&1 < /dev/null &" );
|
|
|
|
say "Started remote runner for ", scalar(@experiments), " experiments";
|
|
|
|
$dbh->disconnect or warn $dbh->errstr;
|