Initial revision

[hcoop/zz_old/domtool.git] / src / util.sml

(*
Domtool (http://hcoop.sf.net/)
Copyright (C) 2004  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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
*)

(* Utility functions *)

structure Util :> UTIL =
struct
    fun impLoop next stop body init =
	let
	    fun loop state =
		let
		    val v = next ()
		in
		    if stop v then
			()
		    else
			loop (body (v, state))
		end
	in
	    loop init
	end

    fun ioLoop next body init = impLoop next (fn s => s = "") body init
    fun ioOptLoop next body init =
	let
	    fun loop state =
		case next () of
		    NONE => ()
		  | SOME v => loop (body (v, state))
	in
	    loop init
	end

    fun isIdent ch = Char.isLower ch orelse Char.isDigit ch

    fun validHost s =
	size s > 0 andalso size s < 20 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 < 20 andalso List.all
						   (fn ch => isIdent 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] => validUser user andalso validDomain host
	   | _ => false)

    fun isTmp s =
	List.exists (fn ch => ch = #"#" orelse ch = #"~") (String.explode s)

    fun validIp s =
	(case map Int.fromString (String.fields (fn ch => ch = #".") s) of
	     [SOME n1, SOME n2, SOME n3, SOME n4] =>
	     n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256
	   | _ => false)

    fun trimLast s =
	if size s = 0 then
	    s
	else
	    String.substring (s, 0, size s - 1)

    fun toDir s =
	foldr (fn (a, s) => s ^ "/" ^ a) "" (String.tokens (fn ch => ch = #".") s)

    fun checkPath (paths, path) =
	StringSet.exists (fn pref => path = pref orelse (size path >= size pref + 2 andalso substring (path, 0, size pref) = pref
						    andalso String.sub (path, size pref) = #"/")) paths
	andalso List.all (fn s => s <> "..") (String.fields (fn ch => ch = #"/") path)

    fun resolveAddr (vars, s) =
	if validIp s then
	    s
	else
	    (case StringMap.find (vars, s) of
		 NONE => ""
	       | SOME v =>
		 if validIp v then
		     v
		 else
		     "")

    fun resolveDomain (vars, s) =
	if validDomain s then
	    s
	else
	    (case StringMap.find (vars, s) of
		 NONE => ""
	       | SOME v =>
		 if validDomain v then
		     v
		 else
		     "")
end