cvsimport

[hcoop/zz_old/portal.git] / quotas.sml

structure Quotas :> QUOTAS =
struct
    fun getQuotas uname =
	let
	    val proc = Unix.execute ("/bin/sh", ["-c", "/usr/bin/vos listvol -long deleuze"])
	    val inf = Unix.textInstreamOf proc

	    fun eatUntilBlankLine () =
		case TextIO.inputLine inf of
		    NONE => ()
		  | SOME "\n" => ()
		  | SOME _ => eatUntilBlankLine ()

	    val suffix = "." ^ uname

	    fun loop acc =
		case TextIO.inputLine inf of
		    NONE => acc
		  | SOME line =>
		    case String.tokens Char.isSpace line of
			[vol, _, _, kbs, _, _] =>
			if String.isSuffix suffix vol then
			    let
				val _ = TextIO.inputLine inf
				val _ = TextIO.inputLine inf
			    in
				case TextIO.inputLine inf of
				    NONE => loop acc
				  | SOME line =>
				    let
					val quota =
					    case String.tokens Char.isSpace line of
						[_, quota, _] => quota
					      | _ => raise Fail "Bad quota string"
				    in
					eatUntilBlankLine ();
					loop ({vol = vol,
					       used = valOf (Int.fromString kbs),
					       quota = valOf (Int.fromString quota)}
					      :: acc)
				    end
			    end
			else
			    (eatUntilBlankLine ();
			     loop acc)
		      | _ => acc

	    val _ = TextIO.inputLine inf
	in
	    loop []
	    before ignore (Unix.reap proc)
	end

    fun goofy s =
	if size s < 2 then
	    raise Fail "Username too short"
	else
	    String.concat [String.substring (s, 0, 1), "/",
			   String.substring (s, 0, 2), "/",
			   s]

    fun splitVol vol =
	let
	    val (befor, after) = Substring.splitl (fn ch => ch <> #".") (Substring.full vol)
	in
	    (Substring.string befor,
	     Substring.string (Substring.slice (after, 1, NONE)))
	end

    fun path vol =
	let
	    val (kind, uname) = splitVol vol
	in
	    case kind of
		"user" => "/afs/hcoop.net/user/" ^ goofy uname
	      | "db" => "/afs/hcoop.net/.databases/" ^ goofy uname
	      | "mail" => "/afs/hcoop.net/user/" ^ goofy uname ^ "/Maildir"
	      | _ => raise Fail ("Don't know how to find mount point for volume " ^ vol)
	end

end