[hcoop/domtool2.git] / src / main.sml

(* HCoop Domtool (http://hcoop.sourceforge.net/)
 * Copyright (c) 2006, Adam Chlipala
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *)

(* Main interface *)

structure Main :> MAIN = struct

open Ast MsgTypes Print

structure SM = StringMap

fun init () = Acl.read Config.aclFile
	    
fun check' G fname =
    let
	val prog = Parse.parse fname
    in
	if !ErrorMsg.anyErrors then
	    G
	else
	    Tycheck.checkFile G (Defaults.tInit ()) prog
    end

fun basis () =
    let
	val dir = Posix.FileSys.opendir Config.libRoot

	fun loop files =
	    case Posix.FileSys.readdir dir of
		NONE => (Posix.FileSys.closedir dir;
			 files)
	      | SOME fname =>
		if String.isSuffix ".dtl" fname then
		    loop (OS.Path.joinDirFile {dir = Config.libRoot,
					       file = fname}
			  :: files)
		else
		    loop files

	val files = loop []
	val (_, files) = Order.order NONE files
    in
	if !ErrorMsg.anyErrors then
	    Env.empty
	else
	    (Tycheck.allowExterns ();
	     foldl (fn (fname, G) => check' G fname) Env.empty files
	     before Tycheck.disallowExterns ())
    end

fun check fname =
    let
	val _ = ErrorMsg.reset ()
	val _ = Env.preTycheck ()

	val b = basis ()
    in
	if !ErrorMsg.anyErrors then
	    raise ErrorMsg.Error
	else
	    let
		val _ = Tycheck.disallowExterns ()
		val _ = ErrorMsg.reset ()
		val prog = Parse.parse fname
	    in
		if !ErrorMsg.anyErrors then
		    raise ErrorMsg.Error
		else
		    let
			val G' = Tycheck.checkFile b (Defaults.tInit ()) prog
		    in
			if !ErrorMsg.anyErrors then
			    raise ErrorMsg.Error
			else
			    (G', #3 prog)
		    end
	    end
    end

val notTmp = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-")

fun checkDir dname =
    let
	val b = basis ()

	val dir = Posix.FileSys.opendir dname

	fun loop files =
	    case Posix.FileSys.readdir dir of
		NONE => (Posix.FileSys.closedir dir;
			 files)
	      | SOME fname =>
		if notTmp fname then
		    loop (OS.Path.joinDirFile {dir = dname,
					       file = fname}
			  :: files)
		else
		    loop files

	val files = loop []
	val (_, files) = Order.order (SOME b) files
    in
	if !ErrorMsg.anyErrors then
	    raise ErrorMsg.Error
	else
	    (foldl (fn (fname, G) => check' G fname) b files;
	     if !ErrorMsg.anyErrors then
		 raise ErrorMsg.Error
	     else
		 ())
    end

fun reduce fname =
    let
	val (G, body) = check fname
    in
	if !ErrorMsg.anyErrors then
	    NONE
	else
	    case body of
		SOME body =>
		let
		    val body' = Reduce.reduceExp G body
		in
		    (*printd (PD.hovBox (PD.PPS.Rel 0,
					 [PD.string "Result:",
					  PD.space 1,
					  p_exp body']))*)
		    SOME body'
		end
	      | _ => NONE
    end

fun eval fname =
    case reduce fname of
	(SOME body') =>
	if !ErrorMsg.anyErrors then
	    raise ErrorMsg.Error
	else
	    Eval.exec (Defaults.eInit ()) body'
      | NONE => raise ErrorMsg.Error

fun eval' fname =
    case reduce fname of
	(SOME body') =>
	if !ErrorMsg.anyErrors then
	    raise ErrorMsg.Error
	else
	    ignore (Eval.exec' (Defaults.eInit ()) body')
      | NONE => raise ErrorMsg.Error

val dispatcher =
    Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort

fun requestContext f =
    let
	val uid = Posix.ProcEnv.getuid ()
	val user = Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid)
		   
	val () = Acl.read Config.aclFile
	val () = Domain.setUser user
		 
	val () = f ()

	val context = OpenSSL.context (Config.certDir ^ "/" ^ user ^ ".pem",
				       Config.keyDir ^ "/" ^ user ^ "/key.pem",
				       Config.trustStore)
    in
	(user, context)
    end

fun requestBio f =
    let
	val (user, context) = requestContext f
    in
	(user, OpenSSL.connect (context, dispatcher))
    end

fun request fname =
    let
	val (user, bio) = requestBio (fn () => ignore (check fname))

	val inf = TextIO.openIn fname

	fun loop lines =
	    case TextIO.inputLine inf of
		NONE => String.concat (List.rev lines)
	      | SOME line => loop (line :: lines)

	val code = loop []
    in
	TextIO.closeIn inf;
	Msg.send (bio, MsgConfig code);
	case Msg.recv bio of
	    NONE => print "Server closed connection unexpectedly.\n"
	  | SOME m =>
	    case m of
		MsgOk => print "Configuration succeeded.\n"
	      | MsgError s => print ("Configuration failed: " ^ s ^ "\n")
	      | _ => print "Unexpected server reply.\n";
	OpenSSL.close bio
    end
    handle ErrorMsg.Error => ()

fun requestDir dname =
    let
	val _ = ErrorMsg.reset ()

	val (user, bio) = requestBio (fn () => checkDir dname)

	val b = basis ()

	val dir = Posix.FileSys.opendir dname

	fun loop files =
	    case Posix.FileSys.readdir dir of
		NONE => (Posix.FileSys.closedir dir;
			 files)
	      | SOME fname =>
		if notTmp fname then
		    loop (OS.Path.joinDirFile {dir = dname,
					       file = fname}
			  :: files)
		else
		    loop files

	val files = loop []
	val (_, files) = Order.order (SOME b) files

	val _ = if !ErrorMsg.anyErrors then
		    raise ErrorMsg.Error
		else
		    ()

	val codes = map (fn fname =>
			    let	    
				val inf = TextIO.openIn fname

				fun loop lines =
				    case TextIO.inputLine inf of
					NONE => String.concat (rev lines)
				      | SOME line => loop (line :: lines)
			    in
				loop []
				before TextIO.closeIn inf
			    end) files
    in
	if !ErrorMsg.anyErrors then
	    ()
	else
	    (Msg.send (bio, MsgMultiConfig codes);
	     case Msg.recv bio of
		 NONE => print "Server closed connection unexpectedly.\n"
	       | SOME m =>
		 case m of
		     MsgOk => print "Configuration succeeded.\n"
		   | MsgError s => print ("Configuration failed: " ^ s ^ "\n")
		   | _ => print "Unexpected server reply.\n";
	     OpenSSL.close bio)
    end
    handle ErrorMsg.Error => ()

fun requestGrant acl =
    let
	val (user, bio) = requestBio (fn () => ())
    in
	Msg.send (bio, MsgGrant acl);
	case Msg.recv bio of
	    NONE => print "Server closed connection unexpectedly.\n"
	  | SOME m =>
	    case m of
		MsgOk => print "Grant succeeded.\n"
	      | MsgError s => print ("Grant failed: " ^ s ^ "\n")
	      | _ => print "Unexpected server reply.\n";
	OpenSSL.close bio
    end

fun requestRevoke acl =
    let
	val (user, bio) = requestBio (fn () => ())
    in
	Msg.send (bio, MsgRevoke acl);
	case Msg.recv bio of
	    NONE => print "Server closed connection unexpectedly.\n"
	  | SOME m =>
	    case m of
		MsgOk => print "Revoke succeeded.\n"
	      | MsgError s => print ("Revoke failed: " ^ s ^ "\n")
	      | _ => print "Unexpected server reply.\n";
	OpenSSL.close bio
    end

fun requestListPerms user =
    let
	val (_, bio) = requestBio (fn () => ())
    in
	Msg.send (bio, MsgListPerms user);
	(case Msg.recv bio of
	     NONE => (print "Server closed connection unexpectedly.\n";
		      NONE)
	   | SOME m =>
	     case m of
		 MsgPerms perms => SOME perms
	       | MsgError s => (print ("Listing failed: " ^ s ^ "\n");
				NONE)
	       | _ => (print "Unexpected server reply.\n";
		       NONE))
	before OpenSSL.close bio
    end

fun requestWhoHas perm =
    let
	val (_, bio) = requestBio (fn () => ())
    in
	Msg.send (bio, MsgWhoHas perm);
	(case Msg.recv bio of
	     NONE => (print "Server closed connection unexpectedly.\n";
		      NONE)
	   | SOME m =>
	     case m of
		 MsgWhoHasResponse users => SOME users
	       | MsgError s => (print ("whohas failed: " ^ s ^ "\n");
				NONE)
	       | _ => (print "Unexpected server reply.\n";
		       NONE))
	before OpenSSL.close bio
    end

fun requestRegen () =
    let
	val (_, bio) = requestBio (fn () => ())
    in
	Msg.send (bio, MsgRegenerate);
	case Msg.recv bio of
	    NONE => print "Server closed connection unexpectedly.\n"
	  | SOME m =>
	    case m of
		MsgOk => print "Regeneration succeeded.\n"
	      | MsgError s => print ("Regeneration failed: " ^ s ^ "\n")
	      | _ => print "Unexpected server reply.\n";
	OpenSSL.close bio
    end

fun requestRmdom dom =
    let
	val (_, bio) = requestBio (fn () => ())
    in
	Msg.send (bio, MsgRmdom dom);
	case Msg.recv bio of
	    NONE => print "Server closed connection unexpectedly.\n"
	  | SOME m =>
	    case m of
		MsgOk => print "Removal succeeded.\n"
	      | MsgError s => print ("Removal failed: " ^ s ^ "\n")
	      | _ => print "Unexpected server reply.\n";
	OpenSSL.close bio
    end

fun regenerate context =
    let
	val b = basis ()
	val () = Tycheck.disallowExterns ()

	val () = Domain.resetGlobal ()

	fun contactNode (node, ip) =
	    if node = Config.defaultNode then
		Domain.resetLocal ()
	    else let
		    val bio = OpenSSL.connect (context,
					       ip
					       ^ ":"
					       ^ Int.toString Config.slavePort)
		in
		    Msg.send (bio, MsgRegenerate);
		    case Msg.recv bio of
			NONE => print "Slave closed connection unexpectedly\n"
		      | SOME m =>
			case m of
			    MsgOk => print ("Slave " ^ node ^ " pre-regeneration finished\n")
			  | MsgError s => print ("Slave " ^ node
						 ^ " returned error: " ^
						 s ^ "\n")
			  | _ => print ("Slave " ^ node
					^ " returned unexpected command\n");
		    OpenSSL.close bio
		end		

	fun doUser user =
	    let
		val _ = Domain.setUser user
		val _ = ErrorMsg.reset ()

		val dname = Config.domtoolDir user

		val dir = Posix.FileSys.opendir dname

		fun loop files =
		    case Posix.FileSys.readdir dir of
			NONE => (Posix.FileSys.closedir dir;
				 files)
		      | SOME fname =>
			if notTmp fname then
			    loop (OS.Path.joinDirFile {dir = dname,
						       file = fname}
				  :: files)
			else
			    loop files

		val files = loop []
		val (_, files) = Order.order (SOME b) files
	    in
		if !ErrorMsg.anyErrors then
		    print ("User " ^ user ^ "'s configuration has errors!\n")
		else
		    app eval' files
	    end
		handle IO.Io _ => ()
		     | OS.SysErr (s, _) => print ("System error processing user " ^ user ^ ": " ^ s ^ "\n")
    in
	app contactNode Config.nodeIps;
	Env.pre ();
	app doUser (Acl.users ());
	Env.post ()
    end

fun service () =
    let
	val () = Acl.read Config.aclFile
	
	val context = OpenSSL.context (Config.serverCert,
				       Config.serverKey,
				       Config.trustStore)
	val _ = Domain.set_context context

	val sock = OpenSSL.listen (context, Config.dispatcherPort)

	fun loop () =
	    case OpenSSL.accept sock of
		NONE => ()
	      | SOME bio =>
		let
		    val user = OpenSSL.peerCN bio
		    val () = print ("\nConnection from " ^ user ^ "\n")
		    val () = Domain.setUser user

		    fun doConfig codes =
			let
			    val _ = print "Configuration:\n"
			    val _ = app (fn s => (print s; print "\n")) codes
			    val _ = print "\n"

			    val outname = OS.FileSys.tmpName ()

			    fun doOne code =
				let
				    val outf = TextIO.openOut outname
				in
				    TextIO.output (outf, code);
				    TextIO.closeOut outf;
				    eval' outname
				end
			in
			    (Env.pre ();
			     app doOne codes;
			     Env.post ();
			     Msg.send (bio, MsgOk))
			    handle ErrorMsg.Error =>
				   (print "Compilation error\n";
				    Msg.send (bio,
					      MsgError "Error during configuration evaluation"))
				 | OpenSSL.OpenSSL s =>
				   (print "OpenSSL error\n";
				    Msg.send (bio,
					      MsgError
						  ("Error during configuration evaluation: "
						   ^ s)));
			   OS.FileSys.remove outname;
			   (ignore (OpenSSL.readChar bio);
			    OpenSSL.close bio)
			   handle OpenSSL.OpenSSL _ => ();
			   loop ()
			end

		    fun cmdLoop () =
			case Msg.recv bio of
			    NONE => (OpenSSL.close bio
				     handle OpenSSL.OpenSSL _ => ();
				     loop ())
			  | SOME m =>
			    case m of
				MsgConfig code => doConfig [code]
			      | MsgMultiConfig codes => doConfig codes

			      | MsgGrant acl =>
				if Acl.query {user = user, class = "priv", value = "all"} then
				    ((Acl.grant acl;
				      Acl.write Config.aclFile;
				      Msg.send (bio, MsgOk);
				      print ("Granted permission " ^ #value acl ^ " to " ^ #user acl ^ " in " ^ #class acl ^ ".\n"))
				     handle OpenSSL.OpenSSL s =>
					    (print "OpenSSL error\n";
					     Msg.send (bio,
						       MsgError
							   ("Error during granting: "
							    ^ s)));
				    (ignore (OpenSSL.readChar bio);
				     OpenSSL.close bio)
				    handle OpenSSL.OpenSSL _ => ();
				    loop ())
				else
				    ((Msg.send (bio, MsgError "Not authorized to grant privileges");
				      print "Unauthorized user asked to grant a permission!\n";
				      ignore (OpenSSL.readChar bio);
				      OpenSSL.close bio)
				     handle OpenSSL.OpenSSL _ => ();
				     loop ())

			      | MsgRevoke acl =>
				if Acl.query {user = user, class = "priv", value = "all"} then
				    ((Acl.revoke acl;
				      Acl.write Config.aclFile;
				      Msg.send (bio, MsgOk);
				      print ("Revoked permission " ^ #value acl ^ " from " ^ #user acl ^ " in " ^ #class acl ^ ".\n"))
				     handle OpenSSL.OpenSSL s =>
					    (print "OpenSSL error\n";
					     Msg.send (bio,
						       MsgError
							   ("Error during revocation: "
							    ^ s)));
				    (ignore (OpenSSL.readChar bio);
				     OpenSSL.close bio)
				    handle OpenSSL.OpenSSL _ => ();
				    loop ())
				else
				    ((Msg.send (bio, MsgError "Not authorized to revoke privileges");
				      print "Unauthorized user asked to revoke a permission!\n";
				      ignore (OpenSSL.readChar bio);
				      OpenSSL.close bio)
				     handle OpenSSL.OpenSSL _ => ();
				     loop ())

			      | MsgListPerms user =>
				((Msg.send (bio, MsgPerms (Acl.queryAll user));
				  print ("Sent permission list for user " ^ user ^ ".\n"))
				 handle OpenSSL.OpenSSL s =>
					(print "OpenSSL error\n";
					 Msg.send (bio,
						   MsgError
						       ("Error during permission listing: "
							^ s)));
				(ignore (OpenSSL.readChar bio);
				 OpenSSL.close bio)
				handle OpenSSL.OpenSSL _ => ();
				loop ())

			      | MsgWhoHas perm =>
				((Msg.send (bio, MsgWhoHasResponse (Acl.whoHas perm));
				  print ("Sent whohas response for " ^ #class perm ^ " / " ^ #value perm ^ ".\n"))
				 handle OpenSSL.OpenSSL s =>
					(print "OpenSSL error\n";
					 Msg.send (bio,
						   MsgError
						       ("Error during whohas: "
							^ s)));
				(ignore (OpenSSL.readChar bio);
				 OpenSSL.close bio)
				handle OpenSSL.OpenSSL _ => ();
				loop ())

			      | MsgRmdom dom =>
				if Acl.query {user = user, class = "priv", value = "all"}
				   orelse Acl.query {user = user, class = "domain", value = dom} then
				    ((Domain.rmdom dom;
				      Msg.send (bio, MsgOk);
				      print ("Removed domain " ^ dom ^ ".\n"))
				     handle OpenSSL.OpenSSL s =>
					    (print "OpenSSL error\n";
					     Msg.send (bio,
						       MsgError
							   ("Error during revocation: "
							    ^ s)));
				    (ignore (OpenSSL.readChar bio);
				     OpenSSL.close bio)
				    handle OpenSSL.OpenSSL _ => ();
				    loop ())
				else
				    ((Msg.send (bio, MsgError "Not authorized to remove that domain");
				      print "Unauthorized user asked to remove a domain!\n";
				      ignore (OpenSSL.readChar bio);
				      OpenSSL.close bio)
				     handle OpenSSL.OpenSSL _ => ();
				     loop ())

			      | MsgRegenerate =>
				if Acl.query {user = user, class = "priv", value = "regen"}
				   orelse Acl.query {user = user, class = "priv", value = "all"} then
				    ((regenerate context;
				      Msg.send (bio, MsgOk);
				      print "Regenerated all configuration.\n")
				     handle OpenSSL.OpenSSL s =>
					    (print "OpenSSL error\n";
					     Msg.send (bio,
						       MsgError
							   ("Error during regeneration: "
							    ^ s)));
				    (ignore (OpenSSL.readChar bio);
				     OpenSSL.close bio)
				    handle OpenSSL.OpenSSL _ => ();
				    loop ())
				else
				    ((Msg.send (bio, MsgError "Not authorized to regeneration");
				      print "Unauthorized user asked to regenerate!\n";
				      ignore (OpenSSL.readChar bio);
				      OpenSSL.close bio)
				     handle OpenSSL.OpenSSL _ => ();
				     loop ())				

			      | _ =>
				(Msg.send (bio, MsgError "Unexpected command")
				 handle OpenSSL.OpenSSL _ => ();
				 OpenSSL.close bio
				 handle OpenSSL.OpenSSL _ => ();
				 loop ())
		in
		    cmdLoop ()
		end
		    handle OpenSSL.OpenSSL s =>
			   (print ("OpenSSL error: " ^ s ^ "\n");
			    OpenSSL.close bio
			    handle OpenSSL.OpenSSL _ => ();
			    loop ())
			 | OS.SysErr (s, _) =>
			   (print ("System error: " ^ s ^ "\n");
			    OpenSSL.close bio
			    handle OpenSSL.OpenSSL _ => ();
			    loop ())
    in
	print "Listening for connections....\n";
	loop ();
	OpenSSL.shutdown sock
    end

fun slave () =
    let
	val host = Slave.hostname ()

	val context = OpenSSL.context (Config.certDir ^ "/" ^ host ^ ".pem",
				       Config.keyDir ^ "/" ^ host ^ "/key.pem",
				       Config.trustStore)

	val sock = OpenSSL.listen (context, Config.slavePort)

	fun loop () =
	    case OpenSSL.accept sock of
		NONE => ()
	      | SOME bio =>
		let
		    val peer = OpenSSL.peerCN bio
		    val () = print ("\nConnection from " ^ peer ^ "\n")
		in
		    if peer <> Config.dispatcherName then
			(print "Not authorized!\n";
			 OpenSSL.close bio;
			 loop ())
		    else let
			    fun loop' files =
				case Msg.recv bio of
				    NONE => print "Dispatcher closed connection unexpectedly\n"
				  | SOME m =>
				    case m of
					MsgFile file => loop' (file :: files)
				      | MsgDoFiles => (Slave.handleChanges files;
						       Msg.send (bio, MsgOk))
				      | MsgRegenerate => (Domain.resetLocal ();
							  Msg.send (bio, MsgOk))
				      | _ => (print "Dispatcher sent unexpected command\n";
					      Msg.send (bio, MsgError "Unexpected command"))
			in
			    loop' [];
			    ignore (OpenSSL.readChar bio);
			    OpenSSL.close bio;
			    loop ()
			end
		end handle OpenSSL.OpenSSL s =>
			   (print ("OpenSSL error: "^ s ^ "\n");
			    OpenSSL.close bio
					  handle OpenSSL.OpenSSL _ => ();
			    loop ())
			 | OS.SysErr (s, _) =>
			   (print ("System error: "^ s ^ "\n");
			    OpenSSL.close bio
			    handle OpenSSL.OpenSSL _ => ();
			    loop ())
    in
	loop ();
	OpenSSL.shutdown sock
    end

fun autodocBasis outdir =
    let
	val dir = Posix.FileSys.opendir Config.libRoot

	fun loop files =
	    case Posix.FileSys.readdir dir of
		NONE => (Posix.FileSys.closedir dir;
			 files)
	      | SOME fname =>
		if String.isSuffix ".dtl" fname then
		    loop (OS.Path.joinDirFile {dir = Config.libRoot,
					       file = fname}
			  :: files)
		else
		    loop files

	val files = loop []
    in
	Autodoc.autodoc {outdir = outdir, infiles = files}
    end

end
Commit	Line	Data
234b917a AC	1	(* HCoop Domtool (http://hcoop.sourceforge.net/)
	2	* Copyright (c) 2006, Adam Chlipala
	3	*
	4	* This program is free software; you can redistribute it and/or
	5	* modify it under the terms of the GNU General Public License
	6	* as published by the Free Software Foundation; either version 2
	7	* of the License, or (at your option) any later version.
	8	*
	9	* This program is distributed in the hope that it will be useful,
	10	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	11	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	12	* GNU General Public License for more details.
	13	*
	14	* You should have received a copy of the GNU General Public License
	15	* along with this program; if not, write to the Free Software
	16	* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
dac62e84	17	*)
234b917a AC	18
	19	(* Main interface *)
	20
	21	structure Main :> MAIN = struct
	22
36e42cb8	23	open Ast MsgTypes Print
234b917a	24
6ae327f8 AC	25	structure SM = StringMap
6ae327f8 AC	26
aa56e112	27	fun init () = Acl.read Config.aclFile
234b917a	28
d189ec0e	29	fun check' G fname =
a3698041 AC	30	let
	31	val prog = Parse.parse fname
	32	in
	33	if !ErrorMsg.anyErrors then
d189ec0e	34	G
a3698041	35	else
aa56e112	36	Tycheck.checkFile G (Defaults.tInit ()) prog
a3698041 AC	37	end
a3698041 AC	38
d189ec0e	39	fun basis () =
234b917a	40	let
d189ec0e AC	41	val dir = Posix.FileSys.opendir Config.libRoot
	42
	43	fun loop files =
	44	case Posix.FileSys.readdir dir of
d612d62c AC	45	NONE => (Posix.FileSys.closedir dir;
d612d62c AC	46	files)
d189ec0e AC	47	\| SOME fname =>
d189ec0e AC	48	if String.isSuffix ".dtl" fname then
d612d62c AC	49	loop (OS.Path.joinDirFile {dir = Config.libRoot,
d612d62c AC	50	file = fname}
d189ec0e AC	51	:: files)
	52	else
	53	loop files
	54
	55	val files = loop []
c53e82e4	56	val (_, files) = Order.order NONE files
d189ec0e	57	in
6ae327f8 AC	58	if !ErrorMsg.anyErrors then
	59	Env.empty
	60	else
b3159a70 AC	61	(Tycheck.allowExterns ();
	62	foldl (fn (fname, G) => check' G fname) Env.empty files
	63	before Tycheck.disallowExterns ())
d189ec0e AC	64	end
	65
	66	fun check fname =
	67	let
	68	val _ = ErrorMsg.reset ()
12adf55a	69	val _ = Env.preTycheck ()
d189ec0e AC	70
d189ec0e AC	71	val b = basis ()
234b917a AC	72	in
234b917a AC	73	if !ErrorMsg.anyErrors then
36e42cb8	74	raise ErrorMsg.Error
234b917a AC	75	else
234b917a AC	76	let
b3159a70	77	val _ = Tycheck.disallowExterns ()
7f012ffd	78	val _ = ErrorMsg.reset ()
d189ec0e	79	val prog = Parse.parse fname
234b917a	80	in
492c1cff	81	if !ErrorMsg.anyErrors then
36e42cb8	82	raise ErrorMsg.Error
492c1cff	83	else
d189ec0e	84	let
aa56e112	85	val G' = Tycheck.checkFile b (Defaults.tInit ()) prog
d189ec0e	86	in
36e42cb8 AC	87	if !ErrorMsg.anyErrors then
	88	raise ErrorMsg.Error
	89	else
	90	(G', #3 prog)
d189ec0e	91	end
234b917a AC	92	end
	93	end
	94
c53e82e4 AC	95	val notTmp = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-")
	96
	97	fun checkDir dname =
	98	let
	99	val b = basis ()
	100
	101	val dir = Posix.FileSys.opendir dname
	102
	103	fun loop files =
	104	case Posix.FileSys.readdir dir of
	105	NONE => (Posix.FileSys.closedir dir;
	106	files)
	107	\| SOME fname =>
	108	if notTmp fname then
	109	loop (OS.Path.joinDirFile {dir = dname,
	110	file = fname}
	111	:: files)
	112	else
	113	loop files
	114
	115	val files = loop []
	116	val (_, files) = Order.order (SOME b) files
	117	in
	118	if !ErrorMsg.anyErrors then
1824f573	119	raise ErrorMsg.Error
c53e82e4 AC	120	else
c53e82e4 AC	121	(foldl (fn (fname, G) => check' G fname) b files;
1824f573 AC	122	if !ErrorMsg.anyErrors then
	123	raise ErrorMsg.Error
	124	else
	125	())
c53e82e4 AC	126	end
c53e82e4 AC	127
d189ec0e	128	fun reduce fname =
a3698041	129	let
d189ec0e	130	val (G, body) = check fname
a3698041 AC	131	in
a3698041 AC	132	if !ErrorMsg.anyErrors then
d189ec0e	133	NONE
a3698041	134	else
d189ec0e AC	135	case body of
	136	SOME body =>
	137	let
	138	val body' = Reduce.reduceExp G body
	139	in
	140	(*printd (PD.hovBox (PD.PPS.Rel 0,
	141	[PD.string "Result:",
	142	PD.space 1,
	143	p_exp body']))*)
	144	SOME body'
	145	end
	146	\| _ => NONE
a3698041 AC	147	end
a3698041 AC	148
d189ec0e AC	149	fun eval fname =
	150	case reduce fname of
	151	(SOME body') =>
	152	if !ErrorMsg.anyErrors then
36e42cb8	153	raise ErrorMsg.Error
d189ec0e	154	else
aa56e112	155	Eval.exec (Defaults.eInit ()) body'
36e42cb8	156	\| NONE => raise ErrorMsg.Error
d189ec0e	157
1824f573 AC	158	fun eval' fname =
	159	case reduce fname of
	160	(SOME body') =>
	161	if !ErrorMsg.anyErrors then
	162	raise ErrorMsg.Error
	163	else
	164	ignore (Eval.exec' (Defaults.eInit ()) body')
	165	\| NONE => raise ErrorMsg.Error
	166
3b267643 AC	167	val dispatcher =
3b267643 AC	168	Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
559e89e9	169
5ee41dd0	170	fun requestContext f =
07cc384c	171	let
a56cc2c3 AC	172	val uid = Posix.ProcEnv.getuid ()
a56cc2c3 AC	173	val user = Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid)
5ee41dd0	174
a56cc2c3 AC	175	val () = Acl.read Config.aclFile
a56cc2c3 AC	176	val () = Domain.setUser user
5ee41dd0 AC	177
5ee41dd0 AC	178	val () = f ()
aa56e112	179
aa56e112	180	val context = OpenSSL.context (Config.certDir ^ "/" ^ user ^ ".pem",
a088cea6	181	Config.keyDir ^ "/" ^ user ^ "/key.pem",
3b267643	182	Config.trustStore)
5ee41dd0 AC	183	in
	184	(user, context)
	185	end
07cc384c	186
5ee41dd0 AC	187	fun requestBio f =
	188	let
	189	val (user, context) = requestContext f
	190	in
	191	(user, OpenSSL.connect (context, dispatcher))
	192	end
	193
	194	fun request fname =
	195	let
	196	val (user, bio) = requestBio (fn () => ignore (check fname))
559e89e9	197
3b267643 AC	198	val inf = TextIO.openIn fname
3b267643 AC	199
36e42cb8	200	fun loop lines =
3b267643	201	case TextIO.inputLine inf of
36e42cb8 AC	202	NONE => String.concat (List.rev lines)
	203	\| SOME line => loop (line :: lines)
	204
	205	val code = loop []
559e89e9	206	in
3b267643	207	TextIO.closeIn inf;
36e42cb8 AC	208	Msg.send (bio, MsgConfig code);
	209	case Msg.recv bio of
	210	NONE => print "Server closed connection unexpectedly.\n"
	211	\| SOME m =>
	212	case m of
	213	MsgOk => print "Configuration succeeded.\n"
	214	\| MsgError s => print ("Configuration failed: " ^ s ^ "\n")
	215	\| _ => print "Unexpected server reply.\n";
3b267643	216	OpenSSL.close bio
559e89e9	217	end
aa56e112	218	handle ErrorMsg.Error => ()
559e89e9	219
c53e82e4 AC	220	fun requestDir dname =
c53e82e4 AC	221	let
1824f573 AC	222	val _ = ErrorMsg.reset ()
	223
	224	val (user, bio) = requestBio (fn () => checkDir dname)
c53e82e4 AC	225
	226	val b = basis ()
	227
	228	val dir = Posix.FileSys.opendir dname
	229
	230	fun loop files =
	231	case Posix.FileSys.readdir dir of
	232	NONE => (Posix.FileSys.closedir dir;
	233	files)
	234	\| SOME fname =>
	235	if notTmp fname then
	236	loop (OS.Path.joinDirFile {dir = dname,
	237	file = fname}
	238	:: files)
	239	else
	240	loop files
	241
	242	val files = loop []
	243	val (_, files) = Order.order (SOME b) files
	244
	245	val _ = if !ErrorMsg.anyErrors then
	246	raise ErrorMsg.Error
	247	else
	248	()
	249
	250	val codes = map (fn fname =>
	251	let
	252	val inf = TextIO.openIn fname
	253
	254	fun loop lines =
	255	case TextIO.inputLine inf of
	256	NONE => String.concat (rev lines)
	257	\| SOME line => loop (line :: lines)
	258	in
	259	loop []
	260	before TextIO.closeIn inf
	261	end) files
	262	in
1824f573 AC	263	if !ErrorMsg.anyErrors then
	264	()
	265	else
	266	(Msg.send (bio, MsgMultiConfig codes);
	267	case Msg.recv bio of
	268	NONE => print "Server closed connection unexpectedly.\n"
	269	\| SOME m =>
	270	case m of
	271	MsgOk => print "Configuration succeeded.\n"
	272	\| MsgError s => print ("Configuration failed: " ^ s ^ "\n")
	273	\| _ => print "Unexpected server reply.\n";
	274	OpenSSL.close bio)
c53e82e4 AC	275	end
	276	handle ErrorMsg.Error => ()
	277
5ee41dd0 AC	278	fun requestGrant acl =
	279	let
	280	val (user, bio) = requestBio (fn () => ())
	281	in
	282	Msg.send (bio, MsgGrant acl);
	283	case Msg.recv bio of
	284	NONE => print "Server closed connection unexpectedly.\n"
	285	\| SOME m =>
	286	case m of
	287	MsgOk => print "Grant succeeded.\n"
	288	\| MsgError s => print ("Grant failed: " ^ s ^ "\n")
	289	\| _ => print "Unexpected server reply.\n";
	290	OpenSSL.close bio
	291	end
	292
411a85f2 AC	293	fun requestRevoke acl =
	294	let
	295	val (user, bio) = requestBio (fn () => ())
	296	in
	297	Msg.send (bio, MsgRevoke acl);
	298	case Msg.recv bio of
	299	NONE => print "Server closed connection unexpectedly.\n"
	300	\| SOME m =>
	301	case m of
	302	MsgOk => print "Revoke succeeded.\n"
	303	\| MsgError s => print ("Revoke failed: " ^ s ^ "\n")
	304	\| _ => print "Unexpected server reply.\n";
	305	OpenSSL.close bio
	306	end
	307
08a04eb4 AC	308	fun requestListPerms user =
	309	let
	310	val (_, bio) = requestBio (fn () => ())
	311	in
	312	Msg.send (bio, MsgListPerms user);
	313	(case Msg.recv bio of
	314	NONE => (print "Server closed connection unexpectedly.\n";
	315	NONE)
	316	\| SOME m =>
	317	case m of
	318	MsgPerms perms => SOME perms
	319	\| MsgError s => (print ("Listing failed: " ^ s ^ "\n");
	320	NONE)
	321	\| _ => (print "Unexpected server reply.\n";
	322	NONE))
	323	before OpenSSL.close bio
	324	end
	325
094877b1 AC	326	fun requestWhoHas perm =
	327	let
	328	val (_, bio) = requestBio (fn () => ())
	329	in
	330	Msg.send (bio, MsgWhoHas perm);
	331	(case Msg.recv bio of
	332	NONE => (print "Server closed connection unexpectedly.\n";
	333	NONE)
	334	\| SOME m =>
	335	case m of
	336	MsgWhoHasResponse users => SOME users
	337	\| MsgError s => (print ("whohas failed: " ^ s ^ "\n");
	338	NONE)
	339	\| _ => (print "Unexpected server reply.\n";
	340	NONE))
	341	before OpenSSL.close bio
	342	end
	343
1824f573 AC	344	fun requestRegen () =
	345	let
	346	val (_, bio) = requestBio (fn () => ())
	347	in
	348	Msg.send (bio, MsgRegenerate);
	349	case Msg.recv bio of
	350	NONE => print "Server closed connection unexpectedly.\n"
	351	\| SOME m =>
	352	case m of
	353	MsgOk => print "Regeneration succeeded.\n"
	354	\| MsgError s => print ("Regeneration failed: " ^ s ^ "\n")
	355	\| _ => print "Unexpected server reply.\n";
	356	OpenSSL.close bio
	357	end
	358
c189cbe9 AC	359	fun requestRmdom dom =
	360	let
	361	val (_, bio) = requestBio (fn () => ())
	362	in
	363	Msg.send (bio, MsgRmdom dom);
	364	case Msg.recv bio of
	365	NONE => print "Server closed connection unexpectedly.\n"
	366	\| SOME m =>
	367	case m of
	368	MsgOk => print "Removal succeeded.\n"
	369	\| MsgError s => print ("Removal failed: " ^ s ^ "\n")
	370	\| _ => print "Unexpected server reply.\n";
	371	OpenSSL.close bio
	372	end
	373
71420f8b	374	fun regenerate context =
1824f573 AC	375	let
1824f573 AC	376	val b = basis ()
71420f8b AC	377	val () = Tycheck.disallowExterns ()
	378
	379	val () = Domain.resetGlobal ()
	380
	381	fun contactNode (node, ip) =
	382	if node = Config.defaultNode then
	383	Domain.resetLocal ()
	384	else let
	385	val bio = OpenSSL.connect (context,
	386	ip
	387	^ ":"
	388	^ Int.toString Config.slavePort)
	389	in
	390	Msg.send (bio, MsgRegenerate);
	391	case Msg.recv bio of
	392	NONE => print "Slave closed connection unexpectedly\n"
	393	\| SOME m =>
	394	case m of
	395	MsgOk => print ("Slave " ^ node ^ " pre-regeneration finished\n")
	396	\| MsgError s => print ("Slave " ^ node
	397	^ " returned error: " ^
	398	s ^ "\n")
	399	\| _ => print ("Slave " ^ node
	400	^ " returned unexpected command\n");
	401	OpenSSL.close bio
	402	end
1824f573 AC	403
	404	fun doUser user =
	405	let
	406	val _ = Domain.setUser user
	407	val _ = ErrorMsg.reset ()
	408
	409	val dname = Config.domtoolDir user
	410
	411	val dir = Posix.FileSys.opendir dname
	412
	413	fun loop files =
	414	case Posix.FileSys.readdir dir of
	415	NONE => (Posix.FileSys.closedir dir;
	416	files)
	417	\| SOME fname =>
	418	if notTmp fname then
	419	loop (OS.Path.joinDirFile {dir = dname,
	420	file = fname}
	421	:: files)
	422	else
	423	loop files
	424
	425	val files = loop []
	426	val (_, files) = Order.order (SOME b) files
	427	in
	428	if !ErrorMsg.anyErrors then
	429	print ("User " ^ user ^ "'s configuration has errors!\n")
	430	else
	431	app eval' files
	432	end
	433	handle IO.Io _ => ()
	434	\| OS.SysErr (s, _) => print ("System error processing user " ^ user ^ ": " ^ s ^ "\n")
	435	in
71420f8b	436	app contactNode Config.nodeIps;
1824f573 AC	437	Env.pre ();
	438	app doUser (Acl.users ());
	439	Env.post ()
	440	end
	441
3b267643	442	fun service () =
07cc384c	443	let
aa56e112 AC	444	val () = Acl.read Config.aclFile
aa56e112 AC	445
3b267643 AC	446	val context = OpenSSL.context (Config.serverCert,
	447	Config.serverKey,
	448	Config.trustStore)
36e42cb8	449	val _ = Domain.set_context context
3b267643	450
60534712	451	val sock = OpenSSL.listen (context, Config.dispatcherPort)
3b267643 AC	452
3b267643 AC	453	fun loop () =
60534712	454	case OpenSSL.accept sock of
3b267643 AC	455	NONE => ()
	456	\| SOME bio =>
	457	let
aa56e112 AC	458	val user = OpenSSL.peerCN bio
	459	val () = print ("\nConnection from " ^ user ^ "\n")
	460	val () = Domain.setUser user
	461
c53e82e4 AC	462	fun doConfig codes =
	463	let
	464	val _ = print "Configuration:\n"
	465	val _ = app (fn s => (print s; print "\n")) codes
	466	val _ = print "\n"
	467
	468	val outname = OS.FileSys.tmpName ()
	469
	470	fun doOne code =
	471	let
	472	val outf = TextIO.openOut outname
	473	in
	474	TextIO.output (outf, code);
	475	TextIO.closeOut outf;
1824f573	476	eval' outname
c53e82e4 AC	477	end
c53e82e4 AC	478	in
1824f573 AC	479	(Env.pre ();
	480	app doOne codes;
	481	Env.post ();
c53e82e4 AC	482	Msg.send (bio, MsgOk))
	483	handle ErrorMsg.Error =>
	484	(print "Compilation error\n";
	485	Msg.send (bio,
	486	MsgError "Error during configuration evaluation"))
	487	\| OpenSSL.OpenSSL s =>
	488	(print "OpenSSL error\n";
	489	Msg.send (bio,
	490	MsgError
	491	("Error during configuration evaluation: "
	492	^ s)));
	493	OS.FileSys.remove outname;
	494	(ignore (OpenSSL.readChar bio);
	495	OpenSSL.close bio)
	496	handle OpenSSL.OpenSSL _ => ();
	497	loop ()
	498	end
	499
36e42cb8 AC	500	fun cmdLoop () =
	501	case Msg.recv bio of
	502	NONE => (OpenSSL.close bio
	503	handle OpenSSL.OpenSSL _ => ();
	504	loop ())
	505	\| SOME m =>
	506	case m of
c53e82e4 AC	507	MsgConfig code => doConfig [code]
c53e82e4 AC	508	\| MsgMultiConfig codes => doConfig codes
5ee41dd0 AC	509
5ee41dd0 AC	510	\| MsgGrant acl =>
be1bea4c	511	if Acl.query {user = user, class = "priv", value = "all"} then
5ee41dd0 AC	512	((Acl.grant acl;
5ee41dd0 AC	513	Acl.write Config.aclFile;
411a85f2 AC	514	Msg.send (bio, MsgOk);
411a85f2 AC	515	print ("Granted permission " ^ #value acl ^ " to " ^ #user acl ^ " in " ^ #class acl ^ ".\n"))
5ee41dd0 AC	516	handle OpenSSL.OpenSSL s =>
	517	(print "OpenSSL error\n";
	518	Msg.send (bio,
	519	MsgError
	520	("Error during granting: "
	521	^ s)));
	522	(ignore (OpenSSL.readChar bio);
	523	OpenSSL.close bio)
	524	handle OpenSSL.OpenSSL _ => ();
	525	loop ())
	526	else
	527	((Msg.send (bio, MsgError "Not authorized to grant privileges");
411a85f2 AC	528	print "Unauthorized user asked to grant a permission!\n";
	529	ignore (OpenSSL.readChar bio);
	530	OpenSSL.close bio)
	531	handle OpenSSL.OpenSSL _ => ();
	532	loop ())
	533
	534	\| MsgRevoke acl =>
be1bea4c	535	if Acl.query {user = user, class = "priv", value = "all"} then
411a85f2 AC	536	((Acl.revoke acl;
	537	Acl.write Config.aclFile;
	538	Msg.send (bio, MsgOk);
	539	print ("Revoked permission " ^ #value acl ^ " from " ^ #user acl ^ " in " ^ #class acl ^ ".\n"))
	540	handle OpenSSL.OpenSSL s =>
	541	(print "OpenSSL error\n";
	542	Msg.send (bio,
	543	MsgError
	544	("Error during revocation: "
	545	^ s)));
	546	(ignore (OpenSSL.readChar bio);
	547	OpenSSL.close bio)
	548	handle OpenSSL.OpenSSL _ => ();
	549	loop ())
	550	else
	551	((Msg.send (bio, MsgError "Not authorized to revoke privileges");
	552	print "Unauthorized user asked to revoke a permission!\n";
5ee41dd0 AC	553	ignore (OpenSSL.readChar bio);
	554	OpenSSL.close bio)
	555	handle OpenSSL.OpenSSL _ => ();
	556	loop ())
	557
08a04eb4 AC	558	\| MsgListPerms user =>
	559	((Msg.send (bio, MsgPerms (Acl.queryAll user));
	560	print ("Sent permission list for user " ^ user ^ ".\n"))
	561	handle OpenSSL.OpenSSL s =>
	562	(print "OpenSSL error\n";
	563	Msg.send (bio,
	564	MsgError
	565	("Error during permission listing: "
	566	^ s)));
	567	(ignore (OpenSSL.readChar bio);
	568	OpenSSL.close bio)
	569	handle OpenSSL.OpenSSL _ => ();
	570	loop ())
	571
094877b1 AC	572	\| MsgWhoHas perm =>
	573	((Msg.send (bio, MsgWhoHasResponse (Acl.whoHas perm));
	574	print ("Sent whohas response for " ^ #class perm ^ " / " ^ #value perm ^ ".\n"))
	575	handle OpenSSL.OpenSSL s =>
	576	(print "OpenSSL error\n";
	577	Msg.send (bio,
	578	MsgError
	579	("Error during whohas: "
	580	^ s)));
	581	(ignore (OpenSSL.readChar bio);
	582	OpenSSL.close bio)
	583	handle OpenSSL.OpenSSL _ => ();
	584	loop ())
	585
c189cbe9 AC	586	\| MsgRmdom dom =>
	587	if Acl.query {user = user, class = "priv", value = "all"}
	588	orelse Acl.query {user = user, class = "domain", value = dom} then
	589	((Domain.rmdom dom;
	590	Msg.send (bio, MsgOk);
	591	print ("Removed domain " ^ dom ^ ".\n"))
	592	handle OpenSSL.OpenSSL s =>
	593	(print "OpenSSL error\n";
	594	Msg.send (bio,
	595	MsgError
	596	("Error during revocation: "
	597	^ s)));
	598	(ignore (OpenSSL.readChar bio);
	599	OpenSSL.close bio)
	600	handle OpenSSL.OpenSSL _ => ();
	601	loop ())
	602	else
	603	((Msg.send (bio, MsgError "Not authorized to remove that domain");
	604	print "Unauthorized user asked to remove a domain!\n";
	605	ignore (OpenSSL.readChar bio);
	606	OpenSSL.close bio)
	607	handle OpenSSL.OpenSSL _ => ();
1824f573 AC	608	loop ())
	609
	610	\| MsgRegenerate =>
	611	if Acl.query {user = user, class = "priv", value = "regen"}
	612	orelse Acl.query {user = user, class = "priv", value = "all"} then
71420f8b	613	((regenerate context;
1824f573 AC	614	Msg.send (bio, MsgOk);
	615	print "Regenerated all configuration.\n")
	616	handle OpenSSL.OpenSSL s =>
	617	(print "OpenSSL error\n";
	618	Msg.send (bio,
	619	MsgError
	620	("Error during regeneration: "
	621	^ s)));
	622	(ignore (OpenSSL.readChar bio);
	623	OpenSSL.close bio)
	624	handle OpenSSL.OpenSSL _ => ();
	625	loop ())
	626	else
	627	((Msg.send (bio, MsgError "Not authorized to regeneration");
	628	print "Unauthorized user asked to regenerate!\n";
	629	ignore (OpenSSL.readChar bio);
	630	OpenSSL.close bio)
	631	handle OpenSSL.OpenSSL _ => ();
c189cbe9 AC	632	loop ())
c189cbe9 AC	633
36e42cb8 AC	634	\| _ =>
	635	(Msg.send (bio, MsgError "Unexpected command")
	636	handle OpenSSL.OpenSSL _ => ();
	637	OpenSSL.close bio
	638	handle OpenSSL.OpenSSL _ => ();
	639	loop ())
	640	in
	641	cmdLoop ()
	642	end
97665758 AC	643	handle OpenSSL.OpenSSL s =>
	644	(print ("OpenSSL error: " ^ s ^ "\n");
	645	OpenSSL.close bio
	646	handle OpenSSL.OpenSSL _ => ();
	647	loop ())
	648	\| OS.SysErr (s, _) =>
	649	(print ("System error: " ^ s ^ "\n");
	650	OpenSSL.close bio
	651	handle OpenSSL.OpenSSL _ => ();
	652	loop ())
36e42cb8	653	in
361a1e7f	654	print "Listening for connections....\n";
36e42cb8 AC	655	loop ();
	656	OpenSSL.shutdown sock
	657	end
	658
	659	fun slave () =
	660	let
6e62228d	661	val host = Slave.hostname ()
36e42cb8 AC	662
36e42cb8 AC	663	val context = OpenSSL.context (Config.certDir ^ "/" ^ host ^ ".pem",
a088cea6	664	Config.keyDir ^ "/" ^ host ^ "/key.pem",
36e42cb8 AC	665	Config.trustStore)
	666
	667	val sock = OpenSSL.listen (context, Config.slavePort)
	668
	669	fun loop () =
	670	case OpenSSL.accept sock of
	671	NONE => ()
	672	\| SOME bio =>
	673	let
	674	val peer = OpenSSL.peerCN bio
	675	val () = print ("\nConnection from " ^ peer ^ "\n")
3b267643	676	in
36e42cb8 AC	677	if peer <> Config.dispatcherName then
	678	(print "Not authorized!\n";
	679	OpenSSL.close bio;
	680	loop ())
	681	else let
	682	fun loop' files =
	683	case Msg.recv bio of
	684	NONE => print "Dispatcher closed connection unexpectedly\n"
	685	\| SOME m =>
	686	case m of
	687	MsgFile file => loop' (file :: files)
	688	\| MsgDoFiles => (Slave.handleChanges files;
	689	Msg.send (bio, MsgOk))
71420f8b AC	690	\| MsgRegenerate => (Domain.resetLocal ();
71420f8b AC	691	Msg.send (bio, MsgOk))
36e42cb8 AC	692	\| _ => (print "Dispatcher sent unexpected command\n";
	693	Msg.send (bio, MsgError "Unexpected command"))
	694	in
	695	loop' [];
	696	ignore (OpenSSL.readChar bio);
	697	OpenSSL.close bio;
	698	loop ()
	699	end
3196000d AC	700	end handle OpenSSL.OpenSSL s =>
	701	(print ("OpenSSL error: "^ s ^ "\n");
	702	OpenSSL.close bio
	703	handle OpenSSL.OpenSSL _ => ();
	704	loop ())
7af7d4cb AC	705	\| OS.SysErr (s, _) =>
	706	(print ("System error: "^ s ^ "\n");
	707	OpenSSL.close bio
	708	handle OpenSSL.OpenSSL _ => ();
	709	loop ())
07cc384c	710	in
3b267643 AC	711	loop ();
3b267643 AC	712	OpenSSL.shutdown sock
07cc384c AC	713	end
07cc384c AC	714
3196000d AC	715	fun autodocBasis outdir =
	716	let
	717	val dir = Posix.FileSys.opendir Config.libRoot
	718
	719	fun loop files =
	720	case Posix.FileSys.readdir dir of
	721	NONE => (Posix.FileSys.closedir dir;
	722	files)
	723	\| SOME fname =>
	724	if String.isSuffix ".dtl" fname then
	725	loop (OS.Path.joinDirFile {dir = Config.libRoot,
	726	file = fname}
	727	:: files)
	728	else
	729	loop files
	730
	731	val files = loop []
	732	in
	733	Autodoc.autodoc {outdir = outdir, infiles = files}
	734	end
	735
234b917a	736	end