1#!/usr/bin/perl
2use strict;
3use warnings;
4use Digest::SHA;
5
6# The /dev/tpm0 device can only be opened by one application at a time, so if
7# the trousers daemon is running, this script will fail.
8system "killall tcsd 2>/dev/null";
9open my $tpm, '+>', '/dev/tpm0' or die "Could not open /dev/tpm0: $!";
10
11sub tpm_cmd_raw {
12	my $msg = join '', @_;
13	my $rsp;
14	print '<<', unpack('H*', $msg), "\n" if $ENV{V};
15	syswrite $tpm, $msg;
16	sysread $tpm, $rsp, 4096;
17	print '>>', unpack('H*', $rsp), "\n" if $ENV{V};
18	$rsp;
19}
20
21sub tpm_cmd_nohdr {
22	my($type, $msg) = @_;
23	my $head = pack 'nN', $type, 6 + length $msg;
24	my $rsp = tpm_cmd_raw $head, $msg;
25	my($rtype, $len, $stat, $reply) = unpack 'nNNa*', $rsp;
26	die "incomplete response" if $len != 10 + length $reply;
27	if ($stat) {
28		print "TPM error: $stat\n";
29		exit 1;
30	}
31	$reply;
32}
33
34sub cmd_list_group {
35	my $group = shift;
36	my($uuid, $pubk, $cfg_list) = unpack 'H32 a256 a*', tpm_cmd_nohdr 0x1C2,
37		pack 'NN', 0x02000107, $group;
38	$uuid = join "-", unpack 'a8a4a4a4a12', $uuid;
39	my $pk_hash = Digest::SHA::sha1_hex($pubk);
40	my $cfg_hash = Digest::SHA::sha1_hex($cfg_list);
41	my($seq, @cfgs) = unpack 'Q> N/(H40) a*', $cfg_list;
42	my @kerns = unpack "N/(H40)", pop @cfgs;
43	print "Group $group ($uuid):\n";
44	print " Public key hash: $pk_hash\n";
45	print " Boot config #$seq ($cfg_hash)\n";
46	print " Platforms:\n";
47	print "  $_\n" for @cfgs;
48	print " Kernels:\n";
49	print "  $_\n" for @kerns;
50	print " VTPMs:\n";
51
52	my($nr, @vtpms) = unpack 'N(H32)*', tpm_cmd_nohdr 0x1C2, pack 'NNN', 0x02000201, $group, 0;
53	if ($nr > @vtpms) {
54		print "  TODO this list is cropped; needs multiple requests\n";
55	}
56	@vtpms = () if $nr == 0; # unpack returns an empty string in this case
57	@vtpms = map { join "-", unpack 'a8a4a4a4a12', $_ } @vtpms;
58	print "  $_\n" for @vtpms;
59}
60
61sub cmd_list {
62	if (@_) {
63		cmd_list_group $_[0];
64	} else {
65		my $nr = unpack 'N', tpm_cmd_nohdr 0x1C2, pack 'N', 0x02000101;
66		cmd_list_group $_ for (0..($nr - 1));
67	}
68}
69
70sub cmd_group_add {
71	my $rsa_modfile = shift;
72	my $ca_digest = "\0"x20;
73	open MOD, $rsa_modfile or die $!;
74	my $group_pubkey = join '', <MOD>;
75	close MOD;
76
77	my($uuid, $pubkey, $pksig) = unpack 'H32 a256 a*', tpm_cmd_nohdr 0x1C2, pack 'N(a*)*',
78		0x02000102, $ca_digest, $group_pubkey;
79	$uuid = join "-", unpack 'a8a4a4a4a12', $uuid;
80	print "$uuid\n";
81	mkdir "group-$uuid";
82	open F, ">group-$uuid/aik.pub";
83	print F $pubkey;
84	close F;
85	open F, ">group-$uuid/aik.priv-ca-data";
86	print F $pksig;
87	close F;
88
89	# TODO certify the AIK using the pTPM's EK (privacy CA)
90	# TODO escrow the recovery key for this group
91}
92
93sub cmd_group_del {
94	my $nr = shift;
95	tpm_cmd_nohdr 0x1C2, pack 'NN', 0x02000103, $nr;
96}
97
98sub cmd_group_update {
99	my $nr = shift;
100	open my $fh, '<', shift;
101	my $cmd = join '', <$fh>;
102	close $fh;
103
104	tpm_cmd_nohdr 0x1C2, pack 'NNa*', 0x02000106, $nr, $cmd;
105}
106
107sub cmd_vtpm_add {
108	my($group,$uuid) = @_;
109	if ($uuid) {
110		$uuid =~ s/-//g;
111		$uuid = pack('H32', $uuid)."\0";
112	} else {
113		$uuid = '';
114	}
115	$uuid = unpack 'H32', tpm_cmd_nohdr 0x1C2, pack 'NNa*', 0x02000204, $group, $uuid;
116	printf "%s\n", join "-", unpack 'a8a4a4a4a12', $uuid;
117}
118
119sub cmd_vtpm_del {
120	my($uuid) = @_;
121	$uuid =~ s/-//g;
122	tpm_cmd_nohdr 0x1C2, pack 'NH32', 0x02000205, $uuid;
123}
124
125sub cmd_help {
126	print <<EOH;
127Usage: $0 <command> <args>
128
129list [index]
130	Lists the group identified by index, or all groups if omitted
131
132group-add rsa-modulus-file
133	Adds a new group to the TPM. The public key and Privacy CA data are
134	output to group-UUID/aik.pub and group-UUID/aik.priv-ca-data, and the
135	UUID is output to stdout.
136
137group-update index signed-config-list-file
138	Updates the permitted boot configuration list for an group
139
140group-del index
141	Deletes a group
142
143vtpm-add index
144	Adds a vTPM. Output: UUID
145
146vtpm-del UUID
147	Deletes a vTPM.
148
149EOH
150}
151
152my $cmd = shift || 'help';
153$cmd =~ s/-/_/g;
154my $fn = $main::{"cmd_$cmd"};
155if ($fn) {
156	$fn->(@ARGV);
157} else {
158	print "Unknown command: $cmd\n";
159	exit 1;
160}
161