Author: eelco
Date: Mon May  9 15:16:34 2011
New Revision: 27200
URL: https://svn.nixos.org/websvn/nix/?rev=27200&sc=1

Log:
* Add a subcommand --info to show the current deployment state.

Modified:
   cloud/trunk/default.nix
   cloud/trunk/src/nixos-deploy-network.pl   (contents, props changed)

Modified: cloud/trunk/default.nix
==============================================================================
--- cloud/trunk/default.nix     Mon May  9 15:02:17 2011        (r27199)
+++ cloud/trunk/default.nix     Mon May  9 15:16:34 2011        (r27200)
@@ -5,13 +5,15 @@
 
   src = lib.cleanSource ./src;
 
-  buildInputs = [ perl makeWrapper perlPackages.XMLLibXML perlPackages.JSON ];
+  buildInputs =
+    [ perl makeWrapper perlPackages.XMLLibXML perlPackages.JSON
+      perlPackages.TextTable perlPackages.ListMoreUtils
+    ];
 
   installPhase = 
     ''
       mkdir -p $out/bin
       cp nixos-deploy-network.pl $out/bin/nixos-deploy-network
-      chmod u+x $out/bin/nixos-deploy-network
       cp *.nix $out/bin/ # urgh
 
       wrapProgram $out/bin/nixos-deploy-network \

Modified: cloud/trunk/src/nixos-deploy-network.pl
==============================================================================
--- cloud/trunk/src/nixos-deploy-network.pl     Mon May  9 15:02:17 2011        
(r27199)
+++ cloud/trunk/src/nixos-deploy-network.pl     Mon May  9 15:16:34 2011        
(r27200)
@@ -6,6 +6,12 @@
 use Cwd;
 use File::Basename;
 use JSON;
+use Getopt::Long qw(:config auto_version);
+use Text::Table;
+use List::MoreUtils qw(uniq);
+
+$main::VERSION = "0.1";
+
 
 binmode(STDERR, ":utf8");
 
@@ -32,10 +38,39 @@
 my $myDir = dirname(Cwd::abs_path($0));
 
 
-sub main {
-    # Parse the command line.
-    processArgs();
-    
+sub opInfo {
+    evalMachineInfo();
+    readState();
+
+    my @lines;
+    foreach my $name (uniq (sort (keys %{$spec->{machines}}, keys 
%{$state->{machines}}))) {
+        my $m = $spec->{machines}->{$name};
+        my $r = $state->{machines}->{$name};
+        push @lines,
+            [ $name
+            , defined $m ? (defined $r ? "Up" : "New") : "Obsolete"
+            , $m->{targetEnv} || $r->{targetEnv}
+            , $r->{vmId}
+            , $r->{ipv6}
+            ];
+    }
+
+    my $table = Text::Table->new(
+        { title => "Name", align => "left" }, \ " | ",
+        { title => "Status", align => "left" }, \ " | ",
+        { title => "Type", align => "left" }, \ " | ",
+        { title => "VM Id", align => "left" }, \ " | ",
+        { title => "IPv6", align => "left" },
+        );
+    $table->load(@lines);
+
+    print $table->title;
+    print $table->rule('-', '+');
+    print $table->body;
+}
+
+
+sub opDeploy {
     # Evaluate the user's network specification to determine machine
     # names and the desired deployment characteristics.
     evalMachineInfo();
@@ -59,9 +94,18 @@
 }
 
 
-sub processArgs {
+sub main {
+    my $op = \&opDeploy;
+    
+    exit 1 unless GetOptions(
+        "state=s" => \$stateFile,
+        "info" => sub { $op = \&opInfo; }
+        );
+    
     @networkExprs = @ARGV;
     die unless scalar @networkExprs > 0;
+
+    &$op();
 }
 
 
_______________________________________________
nix-commits mailing list
[email protected]
http://mail.cs.uu.nl/mailman/listinfo/nix-commits

Reply via email to