1 files changed, 362 insertions, 0 deletions
diff --git a/appl/cmd/auth/factotum/proto/infauth.b b/appl/cmd/auth/factotum/proto/infauth.b
new file mode 100644
index 00000000..244979bc
--- /dev/null
+++ b/appl/cmd/auth/factotum/proto/infauth.b
@@ -0,0 +1,362 @@
+implement Authproto;
+
+include "sys.m";
+	sys: Sys;
+include "draw.m";
+include "keyring.m";
+	keyring: Keyring;
+	IPint: import keyring;
+	SK, PK, Certificate, DigestState: import Keyring;
+include "security.m";
+include "bufio.m";
+include "sexprs.m";
+	sexprs: Sexprs;
+	Sexp: import sexprs;
+include "spki.m";
+	spki: SPKI;
+include "daytime.m";
+	daytime: Daytime;
+include "keyreps.m";
+	keyreps: Keyreps;
+	Keyrep: import keyreps;
+include "../authio.m";
+	authio: Authio;
+	Aattr, Aval, Aquery: import Authio;
+	Attr, IO, Key, Authinfo: import authio;
+
+# at end of authentication, sign a hash of the authenticated username and
+# a secret known only to factotum. that certificate can act as
+# a later proof that this factotum has authenticated that user,
+# and hence factotum will disclose certificates that allow disclosure
+# only to that username.
+
+Debug: con 0;
+
+Maxmsg: con 4000;
+
+Error0, Error1: exception(string);
+
+init(f: Authio): string
+{
+	authio = f;
+	sys = load Sys Sys->PATH;
+	spki = load SPKI SPKI->PATH;
+	spki->init();
+	sexprs = load Sexprs Sexprs->PATH;
+	sexprs->init();
+	keyring = load Keyring Keyring->PATH;
+	daytime = load Daytime Daytime->PATH;
+	keyreps = load Keyreps Keyreps->PATH;
+	keyreps->init();
+	return nil;
+}
+
+interaction(attrs: list of ref Attr, io: ref IO): string
+{
+	ai: ref Authinfo;
+	(key, err) := io.findkey(attrs, "proto=infauth");
+	if(key == nil)
+		return err;
+	info: ref Keyring->Authinfo;
+	(info, err) = keytoauthinfo(key);
+	if(info == nil)
+		return err;
+	anysigner := int authio->lookattrval(key.attrs, "anysigner");
+	rattrs: list of ref Sexp;
+	{
+		# send auth protocol version number
+		sendmsg(io, array of byte "1");
+
+		# get auth protocol version number
+		if(int string getmsg(io) != 1)
+			raise Error0("incompatible authentication protocol");
+
+		# generate alpha**r0
+		p := info.p;
+		low := p.shr(p.bits()/4);
+		r0 := rand(low, p, Random->NotQuiteRandom);
+		αr0 := info.alpha.expmod(r0, p);
+		# trim(αr0);	the IPint library should do this for us, i think.
+
+		# send alpha**r0 mod p, mycert, and mypk
+		sendmsg(io, array of byte αr0.iptob64());
+		sendmsg(io, array of byte keyring->certtostr(info.cert));
+		sendmsg(io, array of byte keyring->pktostr(info.mypk));
+
+		# get alpha**r1 mod p, hiscert, hispk
+		αr1 := IPint.b64toip(string getmsg(io));
+
+		# trying a fast one
+		if(p.cmp(αr1) <= 0)
+			raise Error0("implausible parameter value");
+
+		# if alpha**r1 == alpha**r0, someone may be trying a replay
+		if(αr0.eq(αr1))
+			raise Error0("possible replay attack");
+
+		hiscert := keyring->strtocert(string getmsg(io));
+		if(hiscert == nil && !anysigner)
+			raise Error0(sys->sprint("bad certificate: %r"));
+
+		buf := getmsg(io);
+		hispk := keyring->strtopk(string buf);
+		if(!anysigner){
+			# verify their public key
+			if(verify(info.spk, hiscert, buf) == 0)
+				raise Error0("pk doesn't match certificate");	# likely the signers don't match.
+
+			# check expiration date - in seconds of epoch
+			if(hiscert.exp != 0 && hiscert.exp <= now())
+				raise Error0("certificate expired");
+		}
+		buf = nil;
+
+		# sign alpha**r0 and alpha**r1 and send
+		αcert := sign(info.mysk, "sha", 0, array of byte (αr0.iptob64() + αr1.iptob64()));
+		sendmsg(io, array of byte keyring->certtostr(αcert));
+
+		# get signature of alpha**r1 and alpha**r0 and verify
+		αcert = keyring->strtocert(string getmsg(io));
+		if(αcert == nil)
+			raise Error0("alpha**r1 doesn't match certificate");
+
+		if(verify(hispk, αcert, array of byte (αr1.iptob64() + αr0.iptob64())) == 0)
+			raise Error0(sys->sprint("bad certificate: %r"));
+
+		ai = ref Authinfo;
+		# we are now authenticated and have a common secret, alpha**(r0*r1)
+		if(!anysigner)
+			rattrs = sl(ss("signer") :: principal(info.spk) :: nil) :: rattrs;
+		rattrs = sl(ss("remote-pk") :: principal(hispk) :: nil) :: rattrs;
+		rattrs = sl(ss("local-pk") :: principal(info.mypk) :: nil) :: rattrs;
+		rattrs = sl(ss("secret") :: sb(αr1.expmod(r0, p).iptobytes()) :: nil) :: rattrs;
+		ai.suid = hispk.owner;
+		ai.cuid = info.mypk.owner;
+		sendmsg(io, array of byte "OK");
+	}exception e{
+	Error0 =>
+		err = e;
+		senderr(io, e);
+		break;
+	Error1 =>
+		senderr(io, "missing your authentication data");
+		x: string = e;
+		return "remote: "+x;
+	}
+
+	{	
+		while(string getmsg(io) != "OK")
+			;
+	}exception e{
+	Error0 =>
+		return e;
+	Error1 =>
+		x: string = e;
+		return "remote: "+x;
+	}
+	if(err != nil)
+		return err;
+
+	return negotiatecrypto(io, key, ai, rattrs);
+}
+
+negotiatecrypto(io: ref IO, key: ref Key, ai: ref Authinfo, attrs: list of ref Sexp): string
+{
+	role := authio->lookattrval(key.attrs, "role");
+	alg: string;
+	{
+		if(role == "client"){
+			alg = authio->lookattrval(key.attrs, "alg");
+			if(alg == nil)
+				alg = "md5/rc4_256";
+			sendmsg(io, array of byte alg);
+		}else if(role == "server"){
+			alg = string getmsg(io);
+			if(!algcompatible(alg, sys->tokenize(authio->lookattrval(key.attrs, "algs"), " ").t1))
+				raise Error0("unsupported client algorithm");
+		}
+	}exception e{
+	Error0 or
+	Error1 =>
+		return e;
+	}
+
+	if(alg != nil)
+		attrs = sl(ss("alg") :: ss(alg) :: nil) :: attrs;
+	ai.secret = sl(attrs).pack();
+
+	io.done(ai);
+	return nil;
+}
+
+algcompatible(nil: string, nil: list of string): int
+{
+	return 1;	# XXX
+}
+
+principal(pk: ref Keyring->PK): ref Sexp
+{
+	return spki->(Keyrep.pk(pk).mkkey()).sexp();
+}
+
+ipint(i: int): ref IPint
+{
+	return IPint.inttoip(i);
+}
+
+rand(p, q: ref IPint, nil: int): ref IPint
+{
+	if(p.cmp(q) > 0)
+		(p, q) = (q, p);
+	diff := q.sub(p);
+	q = nil;
+	if(diff.cmp(ipint(2)) < 0){
+		sys->print("rand range must be at least 2");
+		return IPint.inttoip(0);
+	}
+	l := diff.bits();
+	T := ipint(1).shl(l);
+	l = ((l + 7) / 8) * 8;
+	slop := T.div(diff).t1;
+	r: ref IPint;
+	do{
+		r = IPint.random(0, l);
+	}while(r.cmp(slop) < 0);
+	r = r.div(diff).t1.add(p);
+	return r;
+}
+
+now(): int
+{
+	return daytime->now();
+}
+
+Hashfn: type ref fn(a: array of byte, alen: int, digest: array of byte, state: ref DigestState): ref DigestState;
+
+hashalg(ha: string): Hashfn
+{
+	case ha {
+	"sha" or
+	"sha1" =>
+		return keyring->sha1;
+	"md4" =>
+		return keyring->md4;
+	"md5" =>
+		return keyring->md5;
+	}
+	return nil;
+}
+
+sign(sk: ref SK, ha: string, exp: int, buf: array of byte): ref Certificate
+{
+	state := hashalg(ha)(buf, len buf, nil, nil);
+	return keyring->sign(sk, exp, state, ha);
+}
+
+verify(pk: ref PK, cert: ref Certificate, buf: array of byte): int
+{
+	state := hashalg(cert.ha)(buf, len buf, nil, nil);
+	return keyring->verify(pk, cert, state);
+}
+
+getmsg(io: ref IO): array of byte raises (Error0, Error1)
+{
+	while((buf := io.read()) == nil || (n := len buf) < 5)
+		io.toosmall(5);
+	if(len buf != 5)
+		raise Error0("io error: (impossible?) msg length " + string n);
+	h := string buf;
+	if(h[0] == '!')
+		m := int h[1:];
+	else
+		m = int h;
+	while((buf = io.read()) == nil || (n = len buf) < m)
+		io.toosmall(m);
+	if(len buf != m)
+		raise Error0("io error: (impossible?) msg length " + string m);
+	if(h[0] == '!'){
+sys->print("got remote error: %s, len %d\n", string buf, len string buf);
+		raise Error1(string buf);
+	}
+	return buf;
+}
+
+sendmsg(io: ref IO, buf: array of byte)
+{
+	h := sys->aprint("%4.4d\n", len buf);
+	io.write(h, len h);
+	io.write(buf, len buf);
+}
+
+senderr(io: ref IO, e: string)
+{
+	buf := array of byte e;
+	h := sys->aprint("!%3.3d\n", len buf);
+	io.write(h, len h);
+	io.write(buf, len buf);
+}
+
+keytoauthinfo(key:ref Key): (ref Keyring->Authinfo, string)
+{
+	if((s := authio->lookattrval(key.secrets, "!authinfo")) == nil){
+		# XXX could look up authinfo by hash at this point
+		return (nil, "no authinfo attribute");
+	}
+
+	return strtoauthinfo(s);
+}
+
+strtoauthinfo(s: string): (ref Keyring->Authinfo, string)
+{
+	(se, err, nil) := Sexp.parse(s);
+	if(se == nil)
+		return (nil, err);
+	els := se.els();
+	if(len els != 5)
+		return (nil, "bad authinfo contents");
+	ai := ref Keyring->Authinfo;
+	if((ai.spk = keyring->strtopk((hd els).astext())) == nil)
+		return (nil, "bad signer public key");
+	els = tl els;
+	if((ai.cert = keyring->strtocert((hd els).astext())) == nil)
+		return (nil, "bad certificate");
+	els = tl els;
+	if((ai.mysk = keyring->strtosk((hd els).astext())) == nil)
+		return (nil, "bad secret/public key");
+	if((ai.mypk = keyring->sktopk(ai.mysk)) == nil)
+		return (nil, "cannot make pk from sk");
+	els = tl els;
+	if((ai.alpha = IPint.bytestoip((hd els).asdata())) == nil)
+		return (nil, "bad value for alpha");
+	els = tl els;
+	if((ai.p = IPint.bytestoip((hd els).asdata())) == nil)
+		return (nil, "bad value for p");
+	return (ai, nil);
+}
+	
+authinfotostr(ai: ref Keyring->Authinfo): string
+{
+	return (ref Sexp.List(
+		ss(keyring->pktostr(ai.spk)) ::
+		ss(keyring->certtostr(ai.cert)) ::
+		ss(keyring->sktostr(ai.mysk)) ::
+		sb(ai.alpha.iptobytes()) ::
+		sb(ai.p.iptobytes()) ::
+		nil
+	)).b64text();
+}
+
+ss(s: string): ref Sexp.String
+{
+	return ref Sexp.String(s, nil);
+}
+
+sb(d: array of byte): ref Sexp.Binary
+{
+	return ref Sexp.Binary(d, nil);
+}
+
+sl(l: list of ref Sexp): ref Sexp
+{
+	return ref Sexp.List(l);
+}