payment: note that Stripe has instituted an additional 1% fee for non-US cards

[hcoop/portal.git] / stats.sml

structure Stats :> STATS =
struct
   val webbw = Config.statsRoot ^ "webbw"
   val webbw_last = Config.statsRoot ^ "webbw.last"
   val webbw_last2 = Config.statsRoot ^ "webbw.last2"

   type host = {ssl : bool,
		hostname : string,
		id : string}

   fun checkSsl (node, host) =
       let
	   val id = case String.tokens (fn ch => ch = #".") host of
			[] => node ^ "/" ^ host
		      | first :: rest =>
			case rev (String.tokens (fn ch => ch = #"_") first) of
			    "ssl" :: rest' => node ^ "/" ^ String.concatWith "_" (rev rest')
					      ^ "." ^ String.concatWith "." rest ^ ".ssl"
			  | _ => node ^ "/" ^ host
       in
	   case String.fields (fn ch => ch = #".") host of
	       first::rest =>
	       (case String.fields (fn ch => ch = #"_") first of
		    [first, "ssl"] => {ssl = true, hostname = String.concatWith "." (first::rest),
				       id = id}
		  | _ => {ssl = false, hostname = host, id = id})
	     | _ => {ssl = false, hostname = host, id = id}
       end

   fun getWebbw last =
       let
	   val fname =
	       case last of
		   2 => webbw_last2
		 | 1 => webbw_last
		 | 0 => webbw
		 | _ => raise Fail "Asked for too old of a bandwidth file"

	   val inf = TextIO.openIn fname

	   val sum = case TextIO.inputLine inf of
			 NONE => raise Fail "Can't read webbw"
		       | SOME l =>

			 case String.tokens Char.isSpace l of
			     [_, n] => valOf (Int.fromString n)
			   | _ => raise Fail "Bad total in webbw"

	   fun readEm L =
	       case TextIO.inputLine inf of
		   (NONE | SOME "\n") => List.rev L
		 | SOME l =>
		   case String.tokens (fn ch => Char.isSpace ch orelse ch = #":") l of
		       [d, n] =>
		       (case String.tokens (fn ch => ch = #"@") d of
			    [d, node] => readEm ({host = checkSsl (node, d), size = valOf (Int.fromString n)} :: L)
			  | _ => raise Fail ("Bad row in webbw [2]: " ^ l))
		     | _ => raise Fail ("Bad row in webbw [1]: " ^ l)

	   fun splitLast [] = raise Fail "Not enough items for splitLast"
	     | splitLast [x] = ([], x)
	     | splitLast (h::t) =
	       let
		   val (l, x) = splitLast t
	       in
		   (h::l, x)
	       end

	   fun readGroups L =
	       case TextIO.inputLine inf of
		   NONE => List.rev L
		 | SOME l =>
		   case String.tokens (fn ch => Char.isSpace ch orelse ch = #":" orelse ch = #"[" orelse ch = #"]" orelse ch = #",") l of
		       d :: rest =>
		       let
			   val (l, x) = splitLast rest

			   fun split s =
			       case String.tokens (fn ch => ch = #"@") s of
				   [host, node] => (node, host)
				 | _ => raise Fail ("Bad row in webbw [3]: " ^ s)
		       in
			   readGroups ({user = d, hosts = map (checkSsl o split) l, size = valOf (Int.fromString x)} :: L)
		       end
		     | _ => raise Fail ("Bad row in webbw [4]: " ^ l)
       in
	   TextIO.inputLine inf;
	   {total = sum, vhosts = readEm [], users = readGroups []}
	   before TextIO.closeIn inf
       end

   fun getWebbwUser {user, last} =
       let
	   val {vhosts, users, ...} = getWebbw last
       in
	   case List.find (fn {user = u, ...} => u = user) users of
	       NONE => {total = 0, vhosts = []}
	     | SOME {hosts, size, ...} =>
	       {total = size, vhosts = List.filter (fn {host, ...} => List.exists (fn host' => host' = host) hosts) vhosts}
       end
	   

   type disk = {uname : string,
		 kbs : int}

    structure StringKey = struct
    type ord_key = string
    val compare = String.compare
    end
			  
    structure SM = BinaryMapFn(StringKey)

    fun getDiskUsage () =
	let
	    val proc = Unix.execute ("/bin/sh", ["-c", "/usr/bin/vos listvol gibran"])
	    val inf = Unix.textInstreamOf proc

	    fun loop acc =
		case TextIO.inputLine inf of
		    NONE => acc
		  | SOME line =>
		    case String.tokens Char.isSpace line of
			[vol, _, _, kbs, _, _] =>
			let
			    val kbsOld = case SM.find (acc, vol) of
					     NONE => 0
					   | SOME n => n

			    val uname = case String.tokens (fn ch => ch = #".") vol of
					    [_, uname] =>
					    ((Posix.SysDB.getpwnam uname;
					      SOME uname)
					     handle OS.SysErr _ => NONE)
					  | _ => NONE

			    val acc = case uname of
					  NONE => acc
					| SOME uname => SM.insert (acc, uname, valOf (Int.fromString kbs) + kbsOld)
			in
			    loop acc
			end
		      | _ => acc

	    val _ = TextIO.inputLine inf
	    val users = map (fn (uname, kbs) => {uname = uname, kbs = kbs}) (SM.listItemsi (loop SM.empty))
	in
	    ignore (Unix.reap proc);
	    ListMergeSort.sort (fn ({kbs = kbs1, ...}, {kbs = kbs2, ...}) => kbs1 < kbs2) users
	end

end