]> xenbits.xensource.com Git - xen.git/commitdiff
move vtpmmgr helpers from tools to stubdom
authorOlaf Hering <olaf@aepfle.de>
Wed, 1 Oct 2014 16:41:29 +0000 (18:41 +0200)
committerIan Campbell <ian.campbell@citrix.com>
Mon, 6 Oct 2014 16:00:24 +0000 (17:00 +0100)
Tools.mk contains a dead CONFIG_VTPM, @vtpm@ is never expanded because
@vtpm@ is only known by stubdom/configure.ac. Move the two perl scripts
to stubdom/vtpmmgr and install them as executeable. This was introduced
by the recent commit ffa11862aa431494e809c6e99f7358c12cb67e44 ("vtpmmgr:
add example control tools")
Also remove vtpm= from config/Stubdom.mk because vtpm= is (appearently)
not used by make itself.

Signed-off-by: Olaf Hering <olaf@aepfle.de>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
Acked-by: Daniel De Graaf <dgdegra@tycho.nsa.gov>
Cc: Ian Campbell <ian.campbell@citrix.com>
Cc: Ian Jackson <ian.jackson@eu.citrix.com>
Cc: Samuel Thibault <samuel.thibault@ens-lyon.org>
Cc: Stefano Stabellini <stefano.stabellini@eu.citrix.com>
Cc: Wei Liu <wei.liu2@citrix.com>
config/Stubdom.mk.in
config/Tools.mk.in
stubdom/vtpmmgr/Makefile
stubdom/vtpmmgr/calc.pl [new file with mode: 0755]
stubdom/vtpmmgr/manage-vtpmmgr.pl [new file with mode: 0755]
tools/Makefile
tools/vtpmmgr/Makefile [deleted file]
tools/vtpmmgr/calc.pl [deleted file]
tools/vtpmmgr/manage-vtpmmgr.pl [deleted file]

index 9098cbf85d3665629f171515a96d92908d9dfe12..5990fc4e04f938ed9be0bf89a599b21a2adb6bd7 100644 (file)
@@ -6,7 +6,6 @@ FETCHER             := @FETCHER@
 
 # A debug build of stubdom? //FIXME: Someone make this do something
 debug               := @debug@
-vtpm = @vtpm@
 
 STUBDOM_TARGETS     := @STUBDOM_TARGETS@
 STUBDOM_BUILD       := @STUBDOM_BUILD@
index 545bdc0d12ffc656d4f36cd83e57a51e65b62465..89de5bd99cbb232bda523ff78c40e239ea8511c6 100644 (file)
@@ -59,7 +59,6 @@ CONFIG_QEMU_TRAD    := @qemu_traditional@
 CONFIG_QEMU_XEN     := @qemu_xen@
 CONFIG_BLKTAP1      := @blktap1@
 CONFIG_BLKTAP2      := @blktap2@
-CONFIG_VTPM         := @vtpm@
 CONFIG_QEMUU_EXTRA_ARGS:= @EXTRA_QEMUU_CONFIGURE_ARGS@
 CONFIG_REMUS_NETBUF := @remus_netbuf@
 
index a39a22c375caada7d7df37c177e0f8cc491cac60..c5e17c59b1d91854b902d35d80f53a9b21217028 100644 (file)
@@ -23,6 +23,11 @@ build: $(TARGET)
 $(TARGET): $(OBJS)
        ar -rcs $@ $^
 
+install:
+       $(INSTALL_DIR) "$(DESTDIR)$(LIBEXEC_BIN)"
+       $(INSTALL_PROG) calc.pl "$(DESTDIR)$(LIBEXEC_BIN)"
+       $(INSTALL_PROG) manage-vtpmmgr.pl "$(DESTDIR)$(LIBEXEC_BIN)"
+
 clean:
        rm -f $(TARGET) $(OBJS)
 
diff --git a/stubdom/vtpmmgr/calc.pl b/stubdom/vtpmmgr/calc.pl
new file mode 100755 (executable)
index 0000000..4183733
--- /dev/null
@@ -0,0 +1,97 @@
+#!/usr/bin/perl
+use strict;
+use Digest::SHA qw(sha1);
+use Math::BigInt only => 'GMP';
+
+my $s2 = Digest::SHA->new("SHA256");
+
+# The key below is an example; its private key is (obviously) not private. This
+# key must be protected at least as well as the vTPM's secrets, since it can
+# approve the release of these secrets to a new TCB.  It may make sense to
+# modify this script to use a TPM or some other hardware key storage device to
+# hold the private key instead of holding the key in plaintext; such integration
+# is beyond the scope of this example script.
+#
+# The public exponent of this key must be 65537 (0x10001); this is the default
+# for TPM-generated RSA keys.
+#
+# The manage-tpmmgr.pl script expects the modulus of this RSA key to be
+# available; this may be done using:
+#
+# open KEY, '>rsa-modulus-file';
+# print KEY pack 'H*', $rsa_n;
+# close KEY;
+
+my $rsa_n = 'c1580b4ea118a6c2f0a56d5af59b080928a9de7267f824457a1e9d7216013b5a322ff67f72153cd4b58693284490aced3a85d81da909ffe544f934c80340020b5bf514e8850926c6ce3314c3283e33cb79cb6aecf041726782013d07f8171fde4ea8165c6a7050af534ffc1b11ae37ace2ed6436c626edb49bf5bd70ee71f74bf2c132a99e5a6427343dbe46829961755558386436ebea90959161295c78df0127d4e468f9a188b3c1e9b68e5b1e78a450ea437ac7930dab294ede8117f6849d53f11e0bbc8ccef44b7fc9ebd6d7c7532875b3225a9106961771001be618ab3f991ba18edc1b73d73b6b80b5df854f9c9113d0b0cd1fec81a85da3638745fd29';
+my $rsa_d = '3229508daed80173f4114744e111beccf982d0d6a7c8c6484c3da3259535ee9b21083690ac1d7c71c742c9ed1994db7894c562e39716a4106c8ba738f936e310e563b96ff60c00c6757ae53918b8c2a158d100c5c63384a5fc21ac1ee42bc3b5de7c5788d4889d364f8c21e137fe162dc1964b78b682250bc5a6c4e686c6849cf8f0020f6ca383d784e5ffb85da56c2b89dc2e879509b1916c8b51f5907a0dbb7e2f9e5fabc500588ef7db6f78ba4605da86d907493648017ac46a1571ffe9b6a68babeeb277e3a96d346cddc996a94163f1e8393d88f710ff64369a62d3edfc62dbdeae57ee12a33adbb9b9d48d575158117f29fc991cbbbaaa4a47ee974f31';
+
+sub rsa_sign {
+       my $m = '1'.('ff'x218).'003021300906052b0e03021a05000414';
+       $m .= unpack 'H*', sha1(shift);
+       $m = Math::BigInt->from_hex($m);
+       my $n = Math::BigInt->from_hex($rsa_n);
+       my $e = Math::BigInt->from_hex($rsa_d);
+       $m->bmodpow($e, $n);
+       $m = $m->as_hex();
+       $m =~ s/^0x//;
+       $m =~ s/^/0/ while length $m < 512;
+       pack 'H*', $m;
+}
+
+sub auth_update_file {
+       my($dst,$seq) = (shift, shift);
+       my(@plt, @pcrs, @kerns, $cfg);
+       open my $update, '>', $dst or die $!;
+       for (@_) {
+               if (/^([0-9a-fA-F]+)=([0-9a-fA-F]+)$/) {
+                       push @pcrs, pack 'V', hex $1;
+                       push @plt, pack 'H*', $2;
+               } elsif (/^[0-9a-fA-F]{40}$/) {
+                       push @kerns, pack 'H*', $_;
+               } elsif (length $_ == 20) {
+                       push @kerns, $_;
+               } else {
+                       print "Bad argument: $_";
+                       exit 1;
+               }
+       }
+       $cfg = pack 'Q>', $seq;
+       $cfg .= pack 'N/(a20)', @plt;
+       $cfg .= pack 'N/(a20)', @kerns;
+
+       printf "cfg_hash for %s: %s\n", $dst, Digest::SHA::sha1_hex($cfg);
+
+       print $update rsa_sign($cfg);
+       print $update $cfg;
+       print $update map { pack 'n/a3', $_ } @pcrs;
+       close $update;
+}
+
+my $out = shift;
+my $seq = $ENV{SEQ} || time;
+
+if (!$out) {
+       print <<EOF;
+Usage: $0 <output> {<pcrs>=<composite>}* {<kernel>}*
+       <output> is the file that will contain the signed configuration
+       <pcrs> is a 24-bit PCR mask in hexadecimal
+       <composite> is a PCR_COMPOSITE_HASH in hexadecimal
+       <kernel> is a 160-bit vTPM kernel hash in hexadecimal
+
+The sequence number may be specified using the SEQ environment variable,
+otherwise the current UNIX timestamp will be used.  The sequence number of a
+vTPM group must increase on each update.
+
+When the vTPM Manager is compiled without support for a domain builder, the
+SHA-1 hash of the vTPM domain's XSM label is used in place of its kernel hash.
+
+Example:
+       A configuration with two valid command lines and one valid vTPM kernel
+       PCRs 0-7 and 17-19 are being validated (static RTM and TBOOT).
+       $0 auth-0 0e00ff=0593ecb564f532df6ef2f4d7272489da52c4c840 0e00ff=0593ecb564f532df6ef2f4d7272489da52c4c840 2bc65001d506ce6cd12cab90a4a2ad9040d641e1
+EOF
+       exit 0;
+}
+print "Sequence: $seq\n";
+
+auth_update_file $out, $seq, @ARGV;
diff --git a/stubdom/vtpmmgr/manage-vtpmmgr.pl b/stubdom/vtpmmgr/manage-vtpmmgr.pl
new file mode 100755 (executable)
index 0000000..caf4f02
--- /dev/null
@@ -0,0 +1,160 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Digest::SHA;
+
+# The /dev/tpm0 device can only be opened by one application at a time, so if
+# the trousers daemon is running, this script will fail.
+system "killall tcsd 2>/dev/null";
+open my $tpm, '+>', '/dev/tpm0' or die "Could not open /dev/tpm0: $!";
+
+sub tpm_cmd_raw {
+       my $msg = join '', @_;
+       my $rsp;
+       print '<<', unpack('H*', $msg), "\n" if $ENV{V};
+       syswrite $tpm, $msg;
+       sysread $tpm, $rsp, 4096;
+       print '>>', unpack('H*', $rsp), "\n" if $ENV{V};
+       $rsp;
+}
+
+sub tpm_cmd_nohdr {
+       my($type, $msg) = @_;
+       my $head = pack 'nN', $type, 6 + length $msg;
+       my $rsp = tpm_cmd_raw $head, $msg;
+       my($rtype, $len, $stat, $reply) = unpack 'nNNa*', $rsp;
+       die "incomplete response" if $len != 10 + length $reply;
+       if ($stat) {
+               print "TPM error: $stat\n";
+               exit 1;
+       }
+       $reply;
+}
+
+sub cmd_list_group {
+       my $group = shift;
+       my($uuid, $pubk, $cfg_list) = unpack 'H32 a256 a*', tpm_cmd_nohdr 0x1C2,
+               pack 'NN', 0x02000107, $group;
+       $uuid = join "-", unpack 'a8a4a4a4a12', $uuid;
+       my $pk_hash = Digest::SHA::sha1_hex($pubk);
+       my $cfg_hash = Digest::SHA::sha1_hex($cfg_list);
+       my($seq, @cfgs) = unpack 'Q> N/(H40) a*', $cfg_list;
+       my @kerns = unpack "N/(H40)", pop @cfgs;
+       print "Group $group ($uuid):\n";
+       print " Public key hash: $pk_hash\n";
+       print " Boot config #$seq ($cfg_hash)\n";
+       print " Platforms:\n";
+       print "  $_\n" for @cfgs;
+       print " Kernels:\n";
+       print "  $_\n" for @kerns;
+       print " VTPMs:\n";
+
+       my($nr, @vtpms) = unpack 'N(H32)*', tpm_cmd_nohdr 0x1C2, pack 'NNN', 0x02000201, $group, 0;
+       if ($nr > @vtpms) {
+               print "  TODO this list is cropped; needs multiple requests\n";
+       }
+       @vtpms = () if $nr == 0; # unpack returns an empty string in this case
+       @vtpms = map { join "-", unpack 'a8a4a4a4a12', $_ } @vtpms;
+       print "  $_\n" for @vtpms;
+}
+
+sub cmd_list {
+       if (@_) {
+               cmd_list_group $_[0];
+       } else {
+               my $nr = unpack 'N', tpm_cmd_nohdr 0x1C2, pack 'N', 0x02000101;
+               cmd_list_group $_ for (0..($nr - 1));
+       }
+}
+
+sub cmd_group_add {
+       my $rsa_modfile = shift;
+       my $ca_digest = "\0"x20;
+       open MOD, $rsa_modfile or die $!;
+       my $group_pubkey = join '', <MOD>;
+       close MOD;
+
+       my($uuid, $pubkey, $pksig) = unpack 'H32 a256 a*', tpm_cmd_nohdr 0x1C2, pack 'N(a*)*',
+               0x02000102, $ca_digest, $group_pubkey;
+       $uuid = join "-", unpack 'a8a4a4a4a12', $uuid;
+       print "$uuid\n";
+       mkdir "group-$uuid";
+       open F, ">group-$uuid/aik.pub";
+       print F $pubkey;
+       close F;
+       open F, ">group-$uuid/aik.priv-ca-data";
+       print F $pksig;
+       close F;
+
+       # TODO certify the AIK using the pTPM's EK (privacy CA)
+       # TODO escrow the recovery key for this group
+}
+
+sub cmd_group_del {
+       my $nr = shift;
+       tpm_cmd_nohdr 0x1C2, pack 'NN', 0x02000103, $nr;
+}
+
+sub cmd_group_update {
+       my $nr = shift;
+       open my $fh, '<', shift;
+       my $cmd = join '', <$fh>;
+       close $fh;
+
+       tpm_cmd_nohdr 0x1C2, pack 'NNa*', 0x02000106, $nr, $cmd;
+}
+
+sub cmd_vtpm_add {
+       my($group,$uuid) = @_;
+       if ($uuid) {
+               $uuid =~ s/-//g;
+               $uuid = pack('H32', $uuid)."\0";
+       } else {
+               $uuid = '';
+       }
+       $uuid = unpack 'H32', tpm_cmd_nohdr 0x1C2, pack 'NNa*', 0x02000204, $group, $uuid;
+       printf "%s\n", join "-", unpack 'a8a4a4a4a12', $uuid;
+}
+
+sub cmd_vtpm_del {
+       my($uuid) = @_;
+       $uuid =~ s/-//g;
+       tpm_cmd_nohdr 0x1C2, pack 'NH32', 0x02000205, $uuid;
+}
+
+sub cmd_help {
+       print <<EOH;
+Usage: $0 <command> <args>
+
+list [index]
+       Lists the group identified by index, or all groups if omitted
+
+group-add rsa-modulus-file
+       Adds a new group to the TPM. The public key and Privacy CA data are
+       output to group-UUID/aik.pub and group-UUID/aik.priv-ca-data, and the
+       UUID is output to stdout.
+
+group-update index signed-config-list-file
+       Updates the permitted boot configuration list for an group
+
+group-del index
+       Deletes a group
+
+vtpm-add index
+       Adds a vTPM. Output: UUID
+
+vtpm-del UUID
+       Deletes a vTPM.
+
+EOH
+}
+
+my $cmd = shift || 'help';
+$cmd =~ s/-/_/g;
+my $fn = $main::{"cmd_$cmd"};
+if ($fn) {
+       $fn->(@ARGV);
+} else {
+       print "Unknown command: $cmd\n";
+       exit 1;
+}
index 452510ab6d6be7c1d951ec1bf9b0116f2a81b83a..543cd29a133d465d32e3df51b819d6c6d548dad7 100644 (file)
@@ -34,7 +34,6 @@ SUBDIRS-$(CONFIG_X86) += xenpaging
 SUBDIRS-$(CONFIG_X86) += debugger/gdbsx
 SUBDIRS-$(CONFIG_X86) += debugger/kdd
 SUBDIRS-$(CONFIG_TESTS) += tests
-SUBDIRS-$(CONFIG_VTPM) += vtpmmgr
 
 # These don't cross-compile
 ifeq ($(XEN_COMPILE_ARCH),$(XEN_TARGET_ARCH))
diff --git a/tools/vtpmmgr/Makefile b/tools/vtpmmgr/Makefile
deleted file mode 100644 (file)
index b14c170..0000000
+++ /dev/null
@@ -1,15 +0,0 @@
-XEN_ROOT=$(CURDIR)/../..
-include $(XEN_ROOT)/tools/Rules.mk
-
-all:
-       @true
-
-install:
-       $(INSTALL_DIR) "$(DESTDIR)$(LIBEXEC_BIN)"
-       $(INSTALL_DATA) calc.pl "$(DESTDIR)$(LIBEXEC_BIN)"
-       $(INSTALL_DATA) manage-vtpmmgr.pl "$(DESTDIR)$(LIBEXEC_BIN)"
-
-clean:
-       @true
-
-.PHONY: all install clean
diff --git a/tools/vtpmmgr/calc.pl b/tools/vtpmmgr/calc.pl
deleted file mode 100755 (executable)
index 4183733..0000000
+++ /dev/null
@@ -1,97 +0,0 @@
-#!/usr/bin/perl
-use strict;
-use Digest::SHA qw(sha1);
-use Math::BigInt only => 'GMP';
-
-my $s2 = Digest::SHA->new("SHA256");
-
-# The key below is an example; its private key is (obviously) not private. This
-# key must be protected at least as well as the vTPM's secrets, since it can
-# approve the release of these secrets to a new TCB.  It may make sense to
-# modify this script to use a TPM or some other hardware key storage device to
-# hold the private key instead of holding the key in plaintext; such integration
-# is beyond the scope of this example script.
-#
-# The public exponent of this key must be 65537 (0x10001); this is the default
-# for TPM-generated RSA keys.
-#
-# The manage-tpmmgr.pl script expects the modulus of this RSA key to be
-# available; this may be done using:
-#
-# open KEY, '>rsa-modulus-file';
-# print KEY pack 'H*', $rsa_n;
-# close KEY;
-
-my $rsa_n = 'c1580b4ea118a6c2f0a56d5af59b080928a9de7267f824457a1e9d7216013b5a322ff67f72153cd4b58693284490aced3a85d81da909ffe544f934c80340020b5bf514e8850926c6ce3314c3283e33cb79cb6aecf041726782013d07f8171fde4ea8165c6a7050af534ffc1b11ae37ace2ed6436c626edb49bf5bd70ee71f74bf2c132a99e5a6427343dbe46829961755558386436ebea90959161295c78df0127d4e468f9a188b3c1e9b68e5b1e78a450ea437ac7930dab294ede8117f6849d53f11e0bbc8ccef44b7fc9ebd6d7c7532875b3225a9106961771001be618ab3f991ba18edc1b73d73b6b80b5df854f9c9113d0b0cd1fec81a85da3638745fd29';
-my $rsa_d = '3229508daed80173f4114744e111beccf982d0d6a7c8c6484c3da3259535ee9b21083690ac1d7c71c742c9ed1994db7894c562e39716a4106c8ba738f936e310e563b96ff60c00c6757ae53918b8c2a158d100c5c63384a5fc21ac1ee42bc3b5de7c5788d4889d364f8c21e137fe162dc1964b78b682250bc5a6c4e686c6849cf8f0020f6ca383d784e5ffb85da56c2b89dc2e879509b1916c8b51f5907a0dbb7e2f9e5fabc500588ef7db6f78ba4605da86d907493648017ac46a1571ffe9b6a68babeeb277e3a96d346cddc996a94163f1e8393d88f710ff64369a62d3edfc62dbdeae57ee12a33adbb9b9d48d575158117f29fc991cbbbaaa4a47ee974f31';
-
-sub rsa_sign {
-       my $m = '1'.('ff'x218).'003021300906052b0e03021a05000414';
-       $m .= unpack 'H*', sha1(shift);
-       $m = Math::BigInt->from_hex($m);
-       my $n = Math::BigInt->from_hex($rsa_n);
-       my $e = Math::BigInt->from_hex($rsa_d);
-       $m->bmodpow($e, $n);
-       $m = $m->as_hex();
-       $m =~ s/^0x//;
-       $m =~ s/^/0/ while length $m < 512;
-       pack 'H*', $m;
-}
-
-sub auth_update_file {
-       my($dst,$seq) = (shift, shift);
-       my(@plt, @pcrs, @kerns, $cfg);
-       open my $update, '>', $dst or die $!;
-       for (@_) {
-               if (/^([0-9a-fA-F]+)=([0-9a-fA-F]+)$/) {
-                       push @pcrs, pack 'V', hex $1;
-                       push @plt, pack 'H*', $2;
-               } elsif (/^[0-9a-fA-F]{40}$/) {
-                       push @kerns, pack 'H*', $_;
-               } elsif (length $_ == 20) {
-                       push @kerns, $_;
-               } else {
-                       print "Bad argument: $_";
-                       exit 1;
-               }
-       }
-       $cfg = pack 'Q>', $seq;
-       $cfg .= pack 'N/(a20)', @plt;
-       $cfg .= pack 'N/(a20)', @kerns;
-
-       printf "cfg_hash for %s: %s\n", $dst, Digest::SHA::sha1_hex($cfg);
-
-       print $update rsa_sign($cfg);
-       print $update $cfg;
-       print $update map { pack 'n/a3', $_ } @pcrs;
-       close $update;
-}
-
-my $out = shift;
-my $seq = $ENV{SEQ} || time;
-
-if (!$out) {
-       print <<EOF;
-Usage: $0 <output> {<pcrs>=<composite>}* {<kernel>}*
-       <output> is the file that will contain the signed configuration
-       <pcrs> is a 24-bit PCR mask in hexadecimal
-       <composite> is a PCR_COMPOSITE_HASH in hexadecimal
-       <kernel> is a 160-bit vTPM kernel hash in hexadecimal
-
-The sequence number may be specified using the SEQ environment variable,
-otherwise the current UNIX timestamp will be used.  The sequence number of a
-vTPM group must increase on each update.
-
-When the vTPM Manager is compiled without support for a domain builder, the
-SHA-1 hash of the vTPM domain's XSM label is used in place of its kernel hash.
-
-Example:
-       A configuration with two valid command lines and one valid vTPM kernel
-       PCRs 0-7 and 17-19 are being validated (static RTM and TBOOT).
-       $0 auth-0 0e00ff=0593ecb564f532df6ef2f4d7272489da52c4c840 0e00ff=0593ecb564f532df6ef2f4d7272489da52c4c840 2bc65001d506ce6cd12cab90a4a2ad9040d641e1
-EOF
-       exit 0;
-}
-print "Sequence: $seq\n";
-
-auth_update_file $out, $seq, @ARGV;
diff --git a/tools/vtpmmgr/manage-vtpmmgr.pl b/tools/vtpmmgr/manage-vtpmmgr.pl
deleted file mode 100755 (executable)
index caf4f02..0000000
+++ /dev/null
@@ -1,160 +0,0 @@
-#!/usr/bin/perl
-use strict;
-use warnings;
-use Digest::SHA;
-
-# The /dev/tpm0 device can only be opened by one application at a time, so if
-# the trousers daemon is running, this script will fail.
-system "killall tcsd 2>/dev/null";
-open my $tpm, '+>', '/dev/tpm0' or die "Could not open /dev/tpm0: $!";
-
-sub tpm_cmd_raw {
-       my $msg = join '', @_;
-       my $rsp;
-       print '<<', unpack('H*', $msg), "\n" if $ENV{V};
-       syswrite $tpm, $msg;
-       sysread $tpm, $rsp, 4096;
-       print '>>', unpack('H*', $rsp), "\n" if $ENV{V};
-       $rsp;
-}
-
-sub tpm_cmd_nohdr {
-       my($type, $msg) = @_;
-       my $head = pack 'nN', $type, 6 + length $msg;
-       my $rsp = tpm_cmd_raw $head, $msg;
-       my($rtype, $len, $stat, $reply) = unpack 'nNNa*', $rsp;
-       die "incomplete response" if $len != 10 + length $reply;
-       if ($stat) {
-               print "TPM error: $stat\n";
-               exit 1;
-       }
-       $reply;
-}
-
-sub cmd_list_group {
-       my $group = shift;
-       my($uuid, $pubk, $cfg_list) = unpack 'H32 a256 a*', tpm_cmd_nohdr 0x1C2,
-               pack 'NN', 0x02000107, $group;
-       $uuid = join "-", unpack 'a8a4a4a4a12', $uuid;
-       my $pk_hash = Digest::SHA::sha1_hex($pubk);
-       my $cfg_hash = Digest::SHA::sha1_hex($cfg_list);
-       my($seq, @cfgs) = unpack 'Q> N/(H40) a*', $cfg_list;
-       my @kerns = unpack "N/(H40)", pop @cfgs;
-       print "Group $group ($uuid):\n";
-       print " Public key hash: $pk_hash\n";
-       print " Boot config #$seq ($cfg_hash)\n";
-       print " Platforms:\n";
-       print "  $_\n" for @cfgs;
-       print " Kernels:\n";
-       print "  $_\n" for @kerns;
-       print " VTPMs:\n";
-
-       my($nr, @vtpms) = unpack 'N(H32)*', tpm_cmd_nohdr 0x1C2, pack 'NNN', 0x02000201, $group, 0;
-       if ($nr > @vtpms) {
-               print "  TODO this list is cropped; needs multiple requests\n";
-       }
-       @vtpms = () if $nr == 0; # unpack returns an empty string in this case
-       @vtpms = map { join "-", unpack 'a8a4a4a4a12', $_ } @vtpms;
-       print "  $_\n" for @vtpms;
-}
-
-sub cmd_list {
-       if (@_) {
-               cmd_list_group $_[0];
-       } else {
-               my $nr = unpack 'N', tpm_cmd_nohdr 0x1C2, pack 'N', 0x02000101;
-               cmd_list_group $_ for (0..($nr - 1));
-       }
-}
-
-sub cmd_group_add {
-       my $rsa_modfile = shift;
-       my $ca_digest = "\0"x20;
-       open MOD, $rsa_modfile or die $!;
-       my $group_pubkey = join '', <MOD>;
-       close MOD;
-
-       my($uuid, $pubkey, $pksig) = unpack 'H32 a256 a*', tpm_cmd_nohdr 0x1C2, pack 'N(a*)*',
-               0x02000102, $ca_digest, $group_pubkey;
-       $uuid = join "-", unpack 'a8a4a4a4a12', $uuid;
-       print "$uuid\n";
-       mkdir "group-$uuid";
-       open F, ">group-$uuid/aik.pub";
-       print F $pubkey;
-       close F;
-       open F, ">group-$uuid/aik.priv-ca-data";
-       print F $pksig;
-       close F;
-
-       # TODO certify the AIK using the pTPM's EK (privacy CA)
-       # TODO escrow the recovery key for this group
-}
-
-sub cmd_group_del {
-       my $nr = shift;
-       tpm_cmd_nohdr 0x1C2, pack 'NN', 0x02000103, $nr;
-}
-
-sub cmd_group_update {
-       my $nr = shift;
-       open my $fh, '<', shift;
-       my $cmd = join '', <$fh>;
-       close $fh;
-
-       tpm_cmd_nohdr 0x1C2, pack 'NNa*', 0x02000106, $nr, $cmd;
-}
-
-sub cmd_vtpm_add {
-       my($group,$uuid) = @_;
-       if ($uuid) {
-               $uuid =~ s/-//g;
-               $uuid = pack('H32', $uuid)."\0";
-       } else {
-               $uuid = '';
-       }
-       $uuid = unpack 'H32', tpm_cmd_nohdr 0x1C2, pack 'NNa*', 0x02000204, $group, $uuid;
-       printf "%s\n", join "-", unpack 'a8a4a4a4a12', $uuid;
-}
-
-sub cmd_vtpm_del {
-       my($uuid) = @_;
-       $uuid =~ s/-//g;
-       tpm_cmd_nohdr 0x1C2, pack 'NH32', 0x02000205, $uuid;
-}
-
-sub cmd_help {
-       print <<EOH;
-Usage: $0 <command> <args>
-
-list [index]
-       Lists the group identified by index, or all groups if omitted
-
-group-add rsa-modulus-file
-       Adds a new group to the TPM. The public key and Privacy CA data are
-       output to group-UUID/aik.pub and group-UUID/aik.priv-ca-data, and the
-       UUID is output to stdout.
-
-group-update index signed-config-list-file
-       Updates the permitted boot configuration list for an group
-
-group-del index
-       Deletes a group
-
-vtpm-add index
-       Adds a vTPM. Output: UUID
-
-vtpm-del UUID
-       Deletes a vTPM.
-
-EOH
-}
-
-my $cmd = shift || 'help';
-$cmd =~ s/-/_/g;
-my $fn = $main::{"cmd_$cmd"};
-if ($fn) {
-       $fn->(@ARGV);
-} else {
-       print "Unknown command: $cmd\n";
-       exit 1;
-}