src/util.sml

   1 (*
   2 Domtool (http://hcoop.sf.net/)
   3 Copyright (C) 2004  Adam Chlipala
   4
   5 This program is free software; you can redistribute it and/or
   6 modify it under the terms of the GNU General Public License
   7 as published by the Free Software Foundation; either version 2
   8 of the License, or (at your option) any later version.
   9
  10 This program is distributed in the hope that it will be useful,
  11 but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 GNU General Public License for more details.
  14
  15 You should have received a copy of the GNU General Public License
  16 along with this program; if not, write to the Free Software
  17 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  18 *)
  19
  20 (* Utility functions *)
  21
  22 structure Util :> UTIL =
  23 struct
  24     fun impLoop next stop body init =
  25         let
  26             fun loop state =
  27                 let
  28                     val v = next ()
  29                 in
  30                     if stop v then
  31                         ()
  32                     else
  33                         loop (body (v, state))
  34                 end
  35         in
  36             loop init
  37         end
  38
  39     fun ioOptLoop next body init =
  40         let
  41             fun loop state =
  42                 case next () of
  43                     NONE => ()
  44                   | SOME v => loop (body (v, state))
  45         in
  46             loop init
  47         end
  48
  49     fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
  50
  51     fun isInt s = Int.fromString s <> NONE
  52
  53     fun isNat s =
  54         case Int.fromString s of
  55             NONE => false
  56           | SOME n => n >= 0
  57
  58     fun chop s = String.substring (s, 0, size s - 1)
  59
  60     fun validHost s =
  61         size s > 0 andalso size s < 20 andalso List.all isIdent (String.explode s)
  62
  63     fun validDomain s =
  64         size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s)
  65
  66     fun validUser s =
  67         size s > 0 andalso size s < 50 andalso List.all
  68                                                    (fn ch => isIdent ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+")
  69                                                    (String.explode s)
  70
  71     fun validEmailUser s =
  72         size s > 0 andalso size s < 50 andalso List.all
  73                                                    (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-" orelse ch = #"+")
  74                                                    (String.explode s)
  75     fun validEmail s =
  76         (case String.fields (fn ch => ch = #"@") s of
  77              [user, host] => validEmailUser user andalso validDomain host
  78            | _ => false)
  79
  80     fun isTmp s =
  81         List.exists (fn ch => ch = #"#" orelse ch = #"~") (String.explode s)
  82
  83     fun validIp s =
  84         (case map Int.fromString (String.fields (fn ch => ch = #".") s) of
  85              [SOME n1, SOME n2, SOME n3, SOME n4] =>
  86              n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256
  87            | _ => false)
  88
  89     fun trimLast s =
  90         if size s = 0 then
  91             s
  92         else
  93             String.substring (s, 0, size s - 1)
  94
  95     fun toDir s =
  96         foldr (fn (a, s) => s ^ "/" ^ a) "" (String.tokens (fn ch => ch = #".") s)
  97
  98     fun checkPath (paths, path) =
  99         StringSet.exists (fn pref => path = pref orelse (size path >= size pref + 2 andalso substring (path, 0, size pref) = pref
 100                                                     andalso String.sub (path, size pref) = #"/")) paths
 101         andalso List.all (fn s => s <> "..") (String.fields (fn ch => ch = #"/") path)
 102
 103     fun resolveAddr (vars, s) =
 104         if validIp s then
 105             s
 106         else
 107             (case StringMap.find (vars, s) of
 108                  NONE => ""
 109                | SOME v =>
 110                  if validIp v then
 111                      v
 112                  else
 113                      "")
 114
 115     fun resolveDomain (vars, s) =
 116         if validDomain s then
 117             s
 118         else
 119             (case StringMap.find (vars, s) of
 120                  NONE => ""
 121                | SOME v =>
 122                  if validDomain v then
 123                      v
 124                  else
 125                      "")
 126 end
 127