Fix Mailman subscription by installing /usr/local/sbin/portalsub

[bpt/portal.git] / util.sml

structure Util :> UTIL =
struct

datatype 'a flat_element =
	 BEGIN
       | END
       | ITEM of 'a
type 'a flat_tree = 'a flat_element list

fun printInt n =
    Web.print (if n < 0 then
		   "-" ^ Int.toString (~n)
	       else
		   Int.toString n)

fun printReal n =
    Web.print (if n < 0.0 then
		   "-" ^ Real.fmt (StringCvt.FIX (SOME 2)) (~n)
	       else
		   Real.fmt (StringCvt.FIX (SOME 2)) n)

fun id x = x

fun makeSet f items =
    case items of
	[] => "()"
      | [usr] => "(" ^ f usr ^ ")"
      | usr::rest => foldl (fn (usr, s) => s ^ ", " ^ f usr) ("(" ^ f usr) rest ^ ")"

fun neg (r : real) = ~r
fun add (r1 : real, r2) = r1 + r2
fun mult (r1, r2) = real r1 * r2

fun isIdent ch = Char.isLower ch orelse Char.isDigit ch orelse ch = #"-"

fun validHost s =
    size s > 0 andalso size s < 40 andalso List.all isIdent (String.explode s)
					          
fun validDomain s =
    size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s)

fun validUser s =
    size s > 0 andalso size s < 50 andalso List.all
					       (fn ch => isIdent ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+")
					       (String.explode s)

fun validEmailUser s =
    size s > 0 andalso size s < 50 andalso List.all
					       (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+")
					       (String.explode s)

fun validEmail s =
    (case String.fields (fn ch => ch = #"@") s of
	 [user, host] => validEmailUser user andalso validDomain host
       | _ => false)

fun whoisUrl dom = String.concat ["http://reports.internic.net/cgi/whois?whois_nic=", dom, "&type=domain"]

val rnd = ref (Random.rand (0, 0))

fun init () = rnd := Random.rand (SysWord.toInt (Posix.Process.pidToWord (Posix.ProcEnv.getpid ())),
				  SysWord.toInt (Posix.Process.pidToWord (Posix.ProcEnv.getpid ())))

fun randomPassword () = Int.toString (Int.abs (Random.randInt (!rnd)))

fun domainDir dom =
    String.concatWith "/" ("/afs/hcoop.net/common/etc/domtool/nodes/deleuze" :: List.rev (String.fields (fn ch => ch = #".") dom))

fun readFile fname =
    let
	val inf = TextIO.openIn fname

	fun readLines lines =
	    case TextIO.inputLine inf of
		NONE => String.concat (List.rev lines)
	      | SOME line => readLines (line :: lines)
    in
	readLines []
	before TextIO.closeIn inf
    end

fun mem (x, ls) = List.exists (fn y => y = x) ls

val allLower = CharVector.map Char.toLower

fun normEmail s = case String.tokens Char.isSpace (allLower s) of
		      s :: _ => s
		    | [] => ""

end