Index: bin/xen-create-image
===================================================================
RCS file: /home/cvs/xen-tools/bin/xen-create-image,v
retrieving revision 1.178
diff -u -r1.178 xen-create-image
--- bin/xen-create-image	11 Aug 2007 18:24:08 -0000	1.178
+++ bin/xen-create-image	30 Aug 2007 19:12:27 -0000
@@ -550,6 +550,7 @@
 Customise the generated images to remove some packages.
 
 =item xdm
+
 Install an X11 server, using VNC and XDM
 
 =back
@@ -613,21 +614,14 @@
 
 
 use strict;
-use English;
+use English '-no_match_vars';
 use Digest::MD5 qw/ md5_hex /;
 use Env;
 use File::Path qw/ mkpath /;
 use File::Temp qw/ tempdir /;
 use Getopt::Long;
 use Pod::Usage;
-
-
-#
-#  Configuration values read initially from the global configuration
-# file, then optionally overridden by the command line.
-#
-my %CONFIG;
-
+use warnings;
 
 #
 #  Partition layout information values read from the partitions file,
@@ -635,6 +629,51 @@
 #
 my @PARTITIONS = undef;
 
+#
+#  Translatable strings.  TODO: Move these into a database to ease
+#  translation
+#
+my %string;
+
+$string{no_xen_shell} =<<EOF;
+
+  You've specified administrator accounts for use with the xen-shell,
+ however the xen-shell doesn't appear to be installed.
+
+  Aborting.
+EOF
+
+$string{missing_net_script} =<<EOF;
+
+WARNING
+-------
+
+  You appear to have a missing vif-script, or network-script, in the
+ Xen configuration file /etc/xen/xend-config.sxp.
+
+  Please fix this and restart Xend, or your guests will not be able
+ to use any networking!
+
+EOF
+
+$string{dummy_net_script} =<<EOF;
+
+WARNING
+-------
+
+  You appear to have a "dummy" vif-script, or network-script, setting
+ in the Xen configuration file /etc/xen/xend-config.sxp.
+
+  Please fix this and restart Xend, or your guests will not be able to
+ use any networking!
+
+EOF
+
+$string{missing_role_directory} =
+  "The specified role directory '%s' does not exist\n";
+
+$string{missing_partition_directory} =
+  "The specified partitions directory '%s' does not exist\n";
 
 #
 #  Global variable containing the temporary file where our image
@@ -666,11 +705,14 @@
 
 
 
-
+#
+#  Configuration values read initially from the global configuration
+# file, then optionally overridden by the command line.
+#
 #
 #  Setup default options.
 #
-setupDefaultOptions();
+my %CONFIG = setupDefaultOptions();
 
 
 #
@@ -701,7 +743,12 @@
     # Read the file, if it exists.
     if ( -e $path )
     {
-        readConfigurationFile( $path );
+      unless( readConfigurationFile( $path ) ){
+          logprint( "Unable to read configuration file: '$path'\n" .
+                    "Aborting\n\n"
+                  );
+          exit;
+      }
     }
     else
     {
@@ -718,7 +765,12 @@
 #  This is required so that the "--help" flag will work even if our support
 # scripts are not installed, etc.
 #
-checkSystem();
+unless( checkSystem() ){
+    logprint( "Sanity checks failed.\n" .
+              "Aborting\n\n"
+            );
+    exit;
+}
 
 
 #
@@ -732,7 +784,12 @@
 #
 #  Check our arguments were sane and complete.
 #
-checkArguments();
+unless( checkArguments() ){
+    logprint( "Argument checks failed.\n".
+              "Aborting\n\n"
+            );
+    exit;
+}
 
 
 #
@@ -963,7 +1020,9 @@
 
 sub checkSystem
 {
-    my @required = qw ( / xt-customize-image xt-install-image xt-create-xen-config / );
+    my @required = qw ( / xt-customize-image
+                          xt-install-image
+                          xt-create-xen-config / );
 
     foreach my $bin ( @required )
     {
@@ -1001,20 +1060,17 @@
     #
     if ( $CONFIG{'admins'} )
     {
-        my $shell = undef;
-        $shell = "/usr/bin/xen-login-shell" if ( -x "/usr/bin/xen-login-shell" );
-        $shell = "/usr/local/bin/xen-login-shell" if ( -x "/usr/bin/local/xen-login-shell" );
-
-        if ( !defined( $shell ) )
-        {
-            print <<EOF;
 
-  You've specified administrator accounts for use with the xen-shell,
- however the xen-shell doesn't appear to be installed.
+        my @valid_shell =
+          qw(
+             /usr/bin/xen-login-shell
+             /usr/bin/local/xen-login-shell
+            );
 
-  Aborting.
-EOF
-            exit;
+        unless( grep { -x $_ } @valid_shell  ){
+            # TODO: Move strings like this into a translatable db
+            logprint( $string{no_xen_shell} );
+            return 0;
         }
     }
 
@@ -1022,8 +1078,7 @@
     #
     #  Test the system has a valid (network-script) + (vif-script) setup.
     #
-    testXenConfig();
-
+    return testXenConfig();
 }
 
 
@@ -1051,61 +1106,33 @@
     #
     # Read the configuration file.
     #
-    open( CONFIG, "<", "/etc/xen/xend-config.sxp" )
+    open( my $config_fh, q{<}, '/etc/xen/xend-config.sxp' )
       or die "Failed to read /etc/xen/xend-config.sxp: $!";
-    while( <CONFIG> )
+
+    while( my $line = <$config_fh> )
     {
-        next if ( ! $_ || !length( $_ ) );
+        next unless $line;
 
         # vif
-        if ( $_ =~ /^\(vif-script ([^)]+)/ )
-        {
+        if ( $line =~ /^\(vif-script ([^)]+)/ ) {
             $cfg{'vif-script'} = $1;
         }
 
         # network
-        if ( $_ =~ /^\(network-script ([^)]+)/ )
-        {
+        if ( $line =~ /^\(network-script ([^)]+)/ ) {
             $cfg{'network-script'} = $1;
         }
     }
-    close( CONFIG );
+    close( $config_fh );
 
     if ( !defined( $cfg{'network-script'} ) ||
-         !defined( $cfg{'vif-script'} ) )
-    {
-        print <<EOF;
-
-WARNING
--------
-
-  You appear to have a missing vif-script, or network-script, in the
- Xen configuration file /etc/xen/xend-config.sxp.
-
-  Please fix this and restart Xend, or your guests will not be able
- to use any networking!
-
-EOF
-    }
-    else
-    {
-        if ( ( $cfg{'network-script'} =~ /dummy/i ) ||
-             ( $cfg{'vif-script'}     =~ /dummy/i ) )
-        {
-
-            print <<EOF;
-WARNING
--------
-
-  You appear to have a "dummy" vif-script, or network-script, setting
- in the Xen configuration file /etc/xen/xend-config.sxp.
-
-  Please fix this and restart Xend, or your guests will not be able to
- use any networking!
-
-EOF
-        }
+         !defined( $cfg{'vif-script'} ) ) {
+        logprint( $string{missing_net_script} );
+    }elsif ( ( $cfg{'network-script'} =~ /dummy/i ) ||
+             ( $cfg{'vif-script'}     =~ /dummy/i ) ) {
+        logprint( $string{dummy_net_script} );
     }
+    return 1;
 }
 
 
@@ -1121,6 +1148,7 @@
 
 sub setupDefaultOptions
 {
+  my %CONFIG;
 
     #
     # Paths and files.
@@ -1188,6 +1216,7 @@
     $CONFIG{'mount_fs_xfs'}       = '-t xfs';
     $CONFIG{'mount_fs_reiserfs'}  = '-t reiserfs';
 
+    return %CONFIG;
 }
 
 
@@ -1207,20 +1236,17 @@
     my ($file) = ( @_ );
 
     # Don't read the file if it doesn't exist.
-    return if ( ! -e $file );
+    return unless -e $file;
 
+    open( my $fh, q{<}, $file ) or die "Cannot read file '$file' - $!";
 
-    my $line = "";
-
-    open( FILE, "<", $file ) or die "Cannot read file '$file' - $!";
-
-    while (defined($line = <FILE>) )
+    while (defined( my $line = <$fh>) )
     {
         chomp $line;
         if ($line =~ s/\\$//)
         {
-            $line .= <FILE>;
-            redo unless eof(FILE);
+            $line .= <$fh>;
+            redo unless eof($fh);
         }
 
         # Skip lines beginning with comments
@@ -1268,7 +1294,8 @@
         }
     }
 
-    close( FILE );
+    close( $fh );
+    return 1;
 }
 
 
@@ -1338,10 +1365,12 @@
                #
                #  NOTE:  We set the local variable here, not the global.
                #
-               "copy-cmd=s",        \$CONFIG{'copy-cmd'},   # NOP - IGNORED.
                "install-method=s",  \$CONFIG{'install-method'},
                "install-source=s",  \$CONFIG{'install-source'},
-               "tar-cmd=s",         \$CONFIG{'tar-cmd'},   # NOP - IGNORED.
+
+               "copy-cmd=s",        \$CONFIG{'copy-cmd'},      # NOP - IGNORED.
+               "tar-cmd=s",         \$CONFIG{'tar-cmd'},       # NOP - IGNORED.
+               "debootstrap-cmd=s", \$CONFIG{'dbootstrap-cmd'},# NOP - IGNORED.
 
                # Misc. options
                "accounts",     \$CONFIG{'accounts'},
@@ -1424,6 +1453,7 @@
 
         $CONFIG{'swap-dev'} = $install{'swap-dev'} if ( defined( $install{'swap-dev'} ) );
     }
+    return 1;
 }
 
 
@@ -1477,7 +1507,7 @@
     if ( ! defined( $CONFIG{'dist'} ) )
     {
        logprint( "The '--dist' argument is mandatory\n" );
-       exit 1;
+       return 0;
     }
 
     #
@@ -1486,7 +1516,7 @@
     if ( ! defined( $CONFIG{'hostname'} ) )
     {
         logprint( "The '--hostname' argument is mandatory.\n" );
-        exit 1;
+        return 0;
     }
 
     #
@@ -1625,7 +1655,10 @@
     {
         if ( ! -d $CONFIG{'roledir'} )
         {
-            logprint( "The specified role directory '$CONFIG{'roledir'}' does not exist\n" );
+            logprint( sprintf( $string{missing_role_directory},
+                               $CONFIG{roledir}
+                             )
+                    );
             exit 1;
         }
     }
@@ -1634,13 +1667,14 @@
     #
     #  If we've got a partitions directory specified then it must exist.
     #
-    if ( defined( $CONFIG{'partitionsdir'} ) && length( $CONFIG{'partitionsdir'} ) )
-    {
-        if ( ! -d $CONFIG{'partitionsdir'} )
-        {
-            logprint( "The specified partitions directory '$CONFIG{'partitionsdir'}' does not exist\n" );
-            exit 1;
-        }
+    if ( exists $CONFIG{partitionsdir} &&
+         ! -d $CONFIG{partitionsdir}
+       ) {
+      logprint( sprintf( $string{missing_partition_directory},
+                         $CONFIG{partitionsdir}
+                       )
+              );
+      return 0;
     }
 
 
@@ -1803,19 +1837,19 @@
 sub setupLogFile
 {
 
-    mkdir( "/var/log/xen-tools", 0750 ) if ( ! -d "/var/log/xen-tools" );
+    mkdir( '/var/log/xen-tools', oct('0750') ) unless -d '/var/log/xen-tools';
 
     #
     #  Trash any existing for this run logfile.
     #
-    open( TRASH, ">", "/var/log/xen-tools/$CONFIG{'hostname'}.log" );
-    print TRASH "";
-    close(TRASH);
+    open( my $trash_fh, q{>}, "/var/log/xen-tools/$CONFIG{'hostname'}.log" );
+    print $trash_fh '';
+    close($trash_fh);
 
     #
     #  Make sure the logfile is 0640 - avoid leaking root passwords.
     #
-    chmod( oct( "0640" ), "/var/log/xen-tools/$CONFIG{'hostname'}.log" );
+    chmod( oct( '0640' ), "/var/log/xen-tools/$CONFIG{'hostname'}.log" );
 }
 
 
@@ -2353,7 +2387,7 @@
         #
         eval
         {
-            mkpath( $output, 0, 0755 );
+            mkpath( $output, 0, oct('0755') );
         };
         if ( $@ )
         {
@@ -2816,7 +2850,7 @@
             my $image      = $partition->{'image'};
             my $mountpoint = $MOUNT_POINT . $partition->{'mountpoint'};
 
-            mkpath( $mountpoint, 0, 0755 );
+            mkpath( $mountpoint, 0, oct('0755') );
 
             #
             #  Lookup the correct arguments to pass to mount.
@@ -2988,7 +3022,8 @@
     #  Before running any scripts we'll mount /proc in the guest.
     #
     #  1.  Make sure there is a directory.
-    mkdir( $MOUNT_POINT . "/proc", 0755 ) if ( ! -d $MOUNT_POINT . "/proc" );
+    mkdir( $MOUNT_POINT . '/proc', oct('0755') )
+      unless ( -d "$MOUNT_POINT/proc" );
 
     #  2.  Mount
     runCommand( "mount -o bind /proc $MOUNT_POINT/proc" );
@@ -3071,10 +3106,10 @@
     return $ip if ( ! -e $CONFIG{'ipfile'} );
 
     # Read the number.
-    open( OCTET, "<", $CONFIG{'ipfile'} ) or return $ip;
-    my $line = <OCTET>;
+    open( my $octet_fh, q{<}, $CONFIG{'ipfile'} ) or return $ip;
+    my $line = <$octet_fh>;
     $line = 1 if ( ( ! defined( $line ) ) || ( $line !~ /^([0-9]+)$/ ) );
-    close( OCTET );
+    close( $octet_fh );
     chomp( $line );
 
     # Add it
@@ -3082,9 +3117,9 @@
 
     # Increment + write
     $line += 1 ;
-    open( OCTET, ">", $CONFIG{'ipfile'} );
-    print OCTET $line . "\n";
-    close( OCTET );
+    open( $octet_fh, ">", $CONFIG{'ipfile'} );
+    print $octet_fh $line . "\n";
+    close( $octet_fh );
 
     return( $ip );
 }
@@ -3258,10 +3293,10 @@
     #
     if ( $CONFIG{'hostname'} )
     {
-        open( LOGFILE, ">>", "/var/log/xen-tools/$CONFIG{'hostname'}.log" )
+        open( my $log_fh, ">>", "/var/log/xen-tools/$CONFIG{'hostname'}.log" )
           or return;
-        print LOGFILE $text;
-        close( LOGFILE );
+        print $log_fh $text;
+        close( $log_fh );
     }
 }
 
@@ -3293,7 +3328,7 @@
         return $guess if ( -e $guess && -x $guess );
     }
 
-    return undef;
+    return;
 }
 
 
@@ -3371,9 +3406,9 @@
     #
     my @points;
 
-    open( MOUNTED, "<", "/proc/mounts" )
+    open( my $mounts_fh, "<", "/proc/mounts" )
       or die "Failed to open mount list";
-    foreach my $line (<MOUNTED> )
+    foreach my $line (<$mounts_fh> )
     {
         #
         #  Split into the device and mountpoint.
@@ -3385,7 +3420,7 @@
             push @points, $path;
         }
     }
-    close( MOUNTED );
+    close( $mounts_fh );
 
     #
     #  Now we have a list of mounts.  We need to move the
Index: tests/getopt.t
===================================================================
RCS file: /home/cvs/xen-tools/tests/getopt.t,v
retrieving revision 1.4
diff -u -r1.4 getopt.t
--- tests/getopt.t	19 Mar 2007 22:14:43 -0000	1.4
+++ tests/getopt.t	30 Aug 2007 19:12:27 -0000
@@ -20,6 +20,9 @@
 #
 foreach my $file ( sort( glob "./bin/*-*" ) )
 {
+    # Skip CVS backups
+    next if $file =~ /\.~(\d+\.)+\~$/;
+
     testFile( $file );
 }