Commit 1d5c28a9 authored by Leigh Stoller's avatar Leigh Stoller

Merge in the perl 5.8 branch, done by Kevin Atkinson <kevina@cs.utah.edu>.

I fixed a couple of minor problems, but mostly this worked fine. Note that
I have tested this with the installed perl, *NOT* perl 5.8. I am just
making sure this stuff gets committed before too much more bitrot sets in.
parent 5f942a73
......@@ -63,6 +63,15 @@ use libaudit;
use libdb;
use libtestbed;
#
# Function prototypes
#
sub ParseKey($);
sub InitUser();
sub GenerateKeyFiles();
sub GenerateKeyFile($@);
sub fatal($);
#
# Turn off line buffering on output
#
......@@ -423,7 +432,7 @@ sub GenerateKeyFiles()
# Returns 0 on success, -1 on failure.
#
#
sub GenerateKeyFile($$)
sub GenerateKeyFile($@)
{
my ($protocol, @pkeys) = @_;
my $sshdir = "$HOMEDIR/$user/.ssh";
......
......@@ -49,6 +49,11 @@ use libaudit;
use libdb;
use libtestbed;
#
# Function prototypes
#
sub fatal($);
#
# Turn off line buffering on output
#
......
......@@ -9,6 +9,14 @@ use English;
use Getopt::Std;
use Fcntl ':flock';
#
# Load the Testbed support stuff.
#
use lib "@prefix@/lib";
use libaudit;
use libdb;
use libtestbed;
#
# Create user SSL certificates.
#
......@@ -73,12 +81,9 @@ delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
$| = 1;
#
# Load the Testbed support stuff.
# Function prototypes
#
use lib "@prefix@/lib";
use libaudit;
use libdb;
use libtestbed;
sub fatal($);
#
# Rewrite audit version of ARGV to prevent password in mail logs.
......
......@@ -111,6 +111,20 @@ use libaudit;
use libdb;
use libtestbed;
#
# Function prototypes
#
sub AddUser();
sub DelUser();
sub UpdatePassword();
sub UpdateWindowsPassword();
sub UpdateUser(;$);
sub FreezeUser();
sub ThawUser();
sub CheckDotFiles();
sub GenerateSFSKey();
sub fatal($);
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
......
......@@ -107,6 +107,8 @@ sub handler () {
$SIG{INT} = \&handler;
# Do it.
sub BootFromCD();
BootFromCD();
exit(0);
......
......@@ -59,6 +59,24 @@ my $wget = "wget";
my $ifconfig = "ifconfig";
my $logfile = "/tmp/netbed-setup.log";
#
# Function prototypes
#
sub GetInstructions();
sub FinishedInstructions();
sub MakeFS($$);
sub LocalizeRoot();
sub WritePrivKey();
sub MountRoot();
sub UnMountMnt();
sub WriteConfigBlock();
sub GetRootTag();
sub fatal($);
sub mysystem($);
sub mypopen($);
sub Prompt($$;$);
sub VerifySig($$);
#
# Locals
#
......
......@@ -63,6 +63,13 @@ my $scriptfile = "/tmp/netbed-setup.pl";
my $sigfile = "/tmp/netbed-setup.pl.sig";
my $tmpfile = "/tmp/foo.$$";
#
# Function prototypes
#
sub fatal($);
sub mysystem($);
sub Prompt($$;$);
#
# Locals.
#
......
......@@ -117,6 +117,8 @@ sub handler () {
}
$SIG{INT} = \&handler;
sub BootFromCD();
# Do it.
BootFromCD();
exit(0);
......
......@@ -2336,7 +2336,8 @@ outfiles="$outfiles Makeconf GNUmakefile \
robots/mezzanine/mezzcal/GNUmakefile robots/robomonitord \
wiki/GNUmakefile wiki/addwikiuser wiki/wikiproxy \
wiki/usertemplate wiki/webhometemplate \
wiki/delwikiuser wiki/setwikigroups wiki/addwikiproj "
wiki/delwikiuser wiki/setwikigroups wiki/addwikiproj \
daikon/GNUmakefile daikon/daikonize "
#
# Do this for easy distclean.
......
......@@ -774,7 +774,8 @@ outfiles="$outfiles Makeconf GNUmakefile \
robots/mezzanine/mezzcal/GNUmakefile robots/robomonitord \
wiki/GNUmakefile wiki/addwikiuser wiki/wikiproxy \
wiki/usertemplate wiki/webhometemplate \
wiki/delwikiuser wiki/setwikigroups wiki/addwikiproj "
wiki/delwikiuser wiki/setwikigroups wiki/addwikiproj \
daikon/GNUmakefile daikon/daikonize daikon/find_perl "
#
# Do this for easy distclean.
......
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2005 University of Utah and the Flux Group.
# All rights reserved.
#
SRCDIR = @srcdir@
TESTBED_SRCDIR = @top_srcdir@
OBJDIR = ..
SUBDIR = daikon
include $(OBJDIR)/Makeconf
BIN_STUFF = daikonize daikonize.pl find_perl
ETC_STUFF = daikonize.lst
all: $(BIN_STUFF)
include $(TESTBED_SRCDIR)/GNUmakerules
install: all script-install etc-install
script-install: $(addprefix $(INSTALL_BINDIR)/, $(BIN_STUFF))
etc-install: $(addprefix $(INSTALL_ETCDIR)/, $(ETC_STUFF))
boss-install: install
#!/bin/bash
ENVSETUP=/usr/local/daikon/bin/daikon.bashrc
PREFIX=@prefix@
export ENVSETUP PREFIX
. $ENVSETUP
exec perl $PREFIX/bin/daikonize.pl "$@"
bin/nalloc
bin/nodeip
bin/tbend
bin/tbprerun
bin/tbrestart
bin/tbswap
bin/tarfiles_setup
bin/node_history
bin/sshtb
bin/link_config
bin/nsgen
bin/find_perl
sbin/avail
sbin/inuse
sbin/showgraph
sbin/if2port
sbin/webcontrol
sbin/node_status
sbin/unixgroups
sbin/interswitch
sbin/grabron
sbin/stategraph
sbin/idletimes
sbin/idlemail
sbin/changeuid
sbin/update_permissions
sbin/sdisrunning
sbin/sddeploy
sbin/resetvlans
sbin/db2ns
sbin/bwconfig
sbin/savelogs.proxy
sbin/eventsys.proxy
sbin/snmpit.proxy
sbin/vlandiff
sbin/vlansync
sbin/export_tables
sbin/cvsupd.pl
sbin/import_commitlog
sbin/dhcpd_wrapper
sbin/opsreboot
sbin/deletenode
sbin/node_statewait
sbin/grabwebcams
libexec/webnodelog
libexec/webnfree
libexec/webnewwanode
libexec/webidlemail
libexec/xmlconvert
libexec/websearch
libexec/wanlinkinfo
libexec/webnscheck
libexec/webreport
libexec/webendexp
libexec/webbatchexp
libexec/webpanic
libexec/assign_wrapper
libexec/ptopgen
libexec/webnodeupdate
libexec/webdelay_config
libexec/webnodehistory
libexec/webrmgroup
libexec/webswapexp
libexec/webnodecontrol
libexec/webeventsys_control
libexec/webmkgroup
libexec/websetgroups
libexec/webmkproj
libexec/staticroutes
libexec/webnodereboot
libexec/webrmuser
libexec/webidleswap
libexec/webtarfiles_setup
libexec/webfrisbeekiller
libexec/webtbacct
libexec/webaddsfskey
libexec/webaddpubkey
libexec/webmkusercert
libexec/webcreateimage
libexec/newnode
libexec/webdeletenode
libexec/webnsgen
libexec/webvistopology
libexec/webfloormap
libexec/webxmlrpc
libexec/assign_prepass
#!/usr/bin/perl
use warnings;
use strict;
use POSIX qw(WIFEXITED WEXITSTATUS);
my $prefix=$ENV{PREFIX};
$prefix =~ s/\/$//;
my $perl_files_file = "$prefix/etc/daikonize.lst";
my $envsetup=$ENV{ENVSETUP};
# MODES:
# stage1
# stage2
# analyze
# restore -- restore the state to a non-daikonzes state
# clean
# The real perl script is renamed to "*.real.pl"
# The return code is
# 0 - No errors (but some files may have been skipped)
# 1 - Non-fatel errors
# 2 - Fatel errors, should not continue
sub dir_file ($) {$_[0] =~ /^(.+)\/(.+)$/; return ($1,$2);}
sub lchdir (;$) {chdir $prefix; chdir $_[0] if defined $_[0];}
sub create_shell_wrapper ( $$$$$ );
sub in_stage ( $$ ) ;
sub restore ();
sub my_system ( $$ );
#
# These global variables and functions are used for error reporting
#
my $exit = 0;
our $path;
my (@skipped, @failed, @fatel, @success);
sub skip ( $ ); # File skipped
sub error ( $ ); # Error while processing file
sub fatel ( $ ); # Fatel error
sub check_fatel ( ;& );
sub check_exit (); # Report errors and exit
#
#
#
my @perl_files;
open F, $perl_files_file or die "Unable to open $perl_files_file.\n";
while (<F>) {
chop;
# FIXME: Check that each file contains a directory part and
# is not an absolute path.
push @perl_files, $_;
}
my %dirs;
foreach (@perl_files) {my ($d,$f) = dir_file $_; $dirs{$d} = 1;}
my @dirs = sort keys %dirs;
my $mode = $ARGV[0] || '';
if ($mode eq "stage1")
{
lchdir;
foreach $path (@perl_files) {
eval {
fatel "File \"$path\" already in a daikonized state. Run \"daikonize restore\" first."
if -e "$path.real.pl";
};
print STDERR $@ if (defined $@);
}
check_fatel;
foreach $path (@perl_files) {
eval {
my ($d,$f) = dir_file $path;
lchdir $d;
skip "$d/$f doesn't exist, skipping." unless -e $f;
rename $f, "$f.real.pl" or fatel "Unable to rename $f to $f.real.pl";
my_system "dfepl", "dfepl --absolute --dtrace-append $f.real.pl";
create_shell_wrapper $d, $f, 'STAGE1', 'dtype-perl', 'daikon-untyped';
push @success, $path;
};
print STDERR $@ if (defined $@);
}
check_fatel {restore};
foreach my $d (@dirs) {
foreach (qw(daikon-instrumented daikon-output daikon-untyped)) {
mkdir "$d/$_";
chmod 0777, "$d/$_";
}
}
check_exit;
}
elsif ($mode eq "stage2")
{
my @files;
foreach $path (@perl_files) {
eval {
my ($d,$f) = dir_file $path;
lchdir $d;
skip "File \"$path\" not instrumented, skipping."
unless -e "daikon-instrumented/$f.real-main.types";
fatel "File \"$path\" not in stage1."
unless in_stage $f, 1;
push @files, $path;
};
print STDERR $@ if (defined $@);
}
check_fatel;
my @files2;
foreach $path (@files) {
eval {
my ($d,$f) = dir_file $path;
lchdir $d;
my_system "dfepl -T", "dfepl --absolute --dtrace-append -T $f.real.pl";
push @files2, $path;
};
print STDERR $@ if (defined $@);
}
check_fatel;
foreach $path (@files2) {
eval {
my ($d,$f) = dir_file $path;
lchdir $d;
create_shell_wrapper $d, $f, 'STAGE2', 'dtrace-perl', 'daikon-instrumented';
push @success, $path;
};
print STDERR $@ if (defined $@);
}
check_exit;
}
elsif ($mode eq "analyze")
{
my @files;
lchdir;
foreach $path (@perl_files) {
eval {
my ($d,$f) = dir_file $path;
lchdir $d;
skip "Warning: File \"$path\" not instrumented, skipping."
unless -e "daikon-output/$f.real-combined.dtrace";
fatel "File $path not in stage2."
unless in_stage $f, 2;
push @files, $path;
};
print STDERR $@ if (defined $@);
}
check_fatel;
foreach $path (@files) {
eval {
my ($d,$f) = dir_file $path;
lchdir $d;
chdir 'daikon-output';
my_system "java daikon.Daikon", "java daikon.Daikon --omit_from_output 0r -o $f.inv $f.real-main.decls $f.real-combined.dtrace";
push @success, $path;
};
print STDERR $@ if (defined $@);
}
check_exit;
}
elsif ($mode eq "restore")
{
restore;
exit 0;
}
elsif ($mode eq "clean")
{
restore;
lchdir;
foreach (@perl_files) {
my ($d,$f) = dir_file $_;
system "rm -f $d/daikon-*/$f.*; rm -f $d/daikon-*/$f-*";
}
foreach (@dirs) {
system "rmdir $_/daikon-*";
}
exit 0;
}
else
{
print STDERR "Usage: daikonize stage1|stage2|analyze|restore|clean\n";
exit 1;
}
sub restore ()
{
lchdir;
foreach my $f (@perl_files) {
return unless -e "$f.real.pl";
rename "$f.real.pl", $f or print STDERR "Warning: Unable to restore file $f\n";
}
}
sub create_shell_wrapper ($$$$$)
{
my ($d, $f, $stage, $prog, $ed) = @_;
open F, "$f.real.pl";
$_ = <F>;
my ($perl_ops) = /^\#\!.+\/perl (.+)/;
open F, ">$f" or fatel "Unable to create file $f\n";
print F "#!/bin/bash\n";
print F "# $stage\n\n";
print F ". $envsetup\n\n";
print F "exec $prog $perl_ops $prefix/$d/$ed/$f.real.pl \"\$@\"\n";
close F;
chmod 0755, "$f";
}
sub in_stage ($$)
{
my ($f, $stage) = @_;
open F, "$f" or return 0;
<F>;
local $_ = <F>;
/^\# STAGE(.)/ or return 0;
return $1 == $stage;
}
sub my_system ($$) {
my ($c,$cmd) = @_;
print STDERR "Running \"$c\" for $path.\n";
system $cmd;
fatel "\"$c\" failed for $path" unless WIFEXITED($?);
error "\"$c\" failed for $path" unless WEXITSTATUS($?) == 0;
}
#
#
#
sub file_error ($$) {
my ($e, $msg) = @_;
if ($e > $exit) {$exit = $e}
if ($e == 0) {
push @skipped, $path;
die "WARNING: $msg\n";
} if ($e == 1) {
push @failed, $path;
die "ERROR: $msg\n";
} else {
push @fatel, $path;
die "FATEL: $msg\n";
}
}
sub skip ($) {file_error 0, $_[0];}
sub error ($) {file_error 1, $_[0];}
sub fatel ($) {file_error 2, $_[0];}
sub print_file_list ($@) {
my ($msg, @files) = @_;
return 0 unless (@files);
print STDERR "$msg:\n";
foreach my $f (sort @files) {
print STDERR " $f\n";
}
}
sub check_fatel (;&) {
my ($clean_up) = @_;
return unless $exit >= 2;
if ($clean_up) {&$clean_up}
print_file_list "ERROR: There were fatel errors while processing the following files", @fatel;
print STDERR "ERROR: Exiting.\n";
exit $exit;
}
sub check_exit () {
check_fatel;
print_file_list "WARNING: The following files where skipped", @skipped;
print_file_list "WARNING: Unable to process the following files due to errors", @failed;
if (@success) {
print_file_list "The following files were successfully processed", @success;
exit $exit;
} else {
print STDERR "ERROR: Unable to successfully process any files.\n" unless @success;
exit 2;
}
}
#!/usr/bin/perl -w
$prefix = "@prefix@";
$subdirs = "bin/ sbin/ libexec/";
chdir $prefix;
$files = `find $subdirs -type f -maxdepth 1 -print0`;
foreach my $f (split /\0/, $files)
{
die "Already in daikonized state, run \"daikonize restore\" first. (File $f)\n"
if $f =~ /real\.pl$/;
open F, $f;
$_ = <F>;
next unless /\#.+\/perl( .+|)/ || $f =~ /.pl$/;
next if /\/daikonize\.pl$/; # don't daikonize daikoze script as that
# causes all sorts of problems
$_ = defined $1 ? $1 : '';
next if /-\S*T/; # skip chroot scripts for now
print "$f\n";
}
......@@ -16,6 +16,7 @@ sub usage() {
"Use the -d option to see debugging output instead of emailing it.\n";
exit(-1);
}
sub fatal($);
my $optlist = "d";
my $debug = 0;
......
......@@ -50,6 +50,11 @@ $| = 1;
use lib "@prefix@/lib";
use libtestbed;
#
# Function prototypes
#
sub fatal($);
#
# Only real root can call this.
#
......
......@@ -15,6 +15,8 @@ sub usage() {
"Use the -d option to see debugging output instead of emailing it.\n";
exit(-1);
}
sub fatal($);
my $optlist = "vd";
my $debug = 0;
my $verbose = 0;
......
......@@ -18,6 +18,7 @@ sub usage()
}
my $optlist = "d";
my $debug = 0;
sub mysystem($);
#
# Configure variables
......
......@@ -23,6 +23,16 @@ sub usage() {
" -a - Generate all email lists; careful ...\n");
exit(-1);
}
sub ActiveUsers();
sub RecentUsers();
sub RecentProjects();
sub Users();
sub WideAreaPeople();
sub ProjectLeaders();
sub ProjectLists($$);
sub genelist($$$);
my $optlist = "anu:p:tdm";
my $debug = 0;
my $all = 0;
......
......@@ -19,6 +19,11 @@ use lib '@prefix@/lib';
use libdb;
use libtestbed;
sub get_ipmap();
sub get_bandwidths();
sub upload_times($$$);
sub get_times($);
my $TB = '@prefix@';
#
......@@ -37,7 +42,7 @@ if (@ARGV != 1) {
die "Usage: $0 <url>\n";
}
my ($url) = @ARGV;
if (! ($url =~ /^http:\/\/([\w-.]+)\/(.*)$/) ) {
if (! ($url =~ /^http:\/\/([\w.-]+)\/(.*)$/) ) {
die "URL must be in the form http://host/path\n";
}
my ($host,$path) = ($1,$2);
......
......@@ -4721,11 +4721,13 @@ sub min ( $$ ) {
return ($_[0] < $_[1] ? $_[0] : $_[1]);
}
sub hash_recurse2($%);
sub hash_recurse(%) {
my (%hash) = @_;
return hash_recurse2("",%hash);
}
sub array_recurse2($%);
sub array_recurse(%) {
my (%array) = @_;
return array_recurse2("",%array);
......
......@@ -16,6 +16,7 @@ sub usage()
"newwanode [-w] [-n nickname] -t <nodetype> -i <ip address>\n";
exit(1);
}
sub fatal($);
my $optlist = "wt:i:a:n:";
#
......
......@@ -15,6 +15,11 @@ use strict;
# they differ or not
#
#
# Function prototypes
#
sub fatal(@);
#
# Configure variables
#
......
......@@ -16,6 +16,11 @@ use strict;
# they differ or not
#