Better checking of Block arguments

diff --git a/src/apache/apache.sml b/src/apache/apache.sml
index 136ece3..adb61c9 100644 (file)
--- a/src/apache/apache.sml
+++ b/src/apache/apache.sml
@@ -95,6 +95,16 @@ struct
            List.all checkField fields
        end
 
+    fun validDenyMask s =
+       let
+           val fs = String.fields (fn ch => ch = #".") s
+       in
+           (length fs <= 4 andalso List.all (fn s => case Int.fromString s of
+                                                         SOME n => n >= 0 andalso n < 256
+                                                       | NONE => false) fs)
+           orelse validDomain s
+       end
+
     fun handler (data : Domtool.handlerData) =
        let
            val path = #path data
@@ -408,7 +418,11 @@ struct
                                        "\tSatisfy any\n")
                     else
                         Domtool.error (path, "HcoopPrivate only allowed for SSL vhosts")
-                  | ["Block", pat] => blocked := pat :: (!blocked)
+                  | ["Block", pat] =>
+                    if validDenyMask pat then
+                        blocked := pat :: (!blocked)
+                    else
+                        Domtool.error (path, "Invalid block mask")
                   | ["Default"] => (TextIO.output (vhosts, "\tServerAlias " ^ parent ^ "\n");
                                     TextIO.output (conf, "HideSite\t" ^ parent ^ "\n" ^
                                                          "HideReferrer\t" ^ parent ^ "\n"))

diff --git a/src/djbdns/djbdns.sml b/src/djbdns/djbdns.sml
index 4f05e91..d8c9ac3 100644 (file)
--- a/src/djbdns/djbdns.sml
+++ b/src/djbdns/djbdns.sml
@@ -283,13 +283,14 @@ struct
                        val st = Posix.FileSys.stat fullName
                    in
                        if Posix.FileSys.ST.isDir st then
-                           if OS.Process.isSuccess (OS.Process.system (rsync ^ " -az --delete " ^ fullName ^ "/*.dns `" ^ cat ^ " " ^ fullName ^ "/destination`")) then
+                           ()
+                           (*if OS.Process.isSuccess (OS.Process.system (rsync ^ " -az --delete " ^ fullName ^ "/*.dns `" ^ cat ^ " " ^ fullName ^ "/destination`")) then
                                if OS.Process.isSuccess (OS.Process.system (rsync ^ " -az --delete " ^ fullName ^ "/slaves/* `" ^ cat ^ " " ^ fullName ^ "/slaves_destination`")) then
                                    ()
                                else
                                    print ("Error sending sub-slaves to slave " ^ name ^ "\n")
                            else
-                               print ("Error sending to slave " ^ name ^ "\n")
+                               print ("Error sending to slave " ^ name ^ "\n")*)
                        else
                            ()
                    end

diff --git a/src/util.sml b/src/util.sml
index dc0c0b7..cff33d5 100644 (file)
--- a/src/util.sml
+++ b/src/util.sml
@@ -65,10 +65,14 @@ struct
     fun chop s = String.substring (s, 0, size s - 1)
 
     fun validHost s =
-       size s > 0 andalso size s < 30 andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s
+       size s > 0 andalso size s < 30
+       andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s
+       andalso CharVector.exists (fn ch => not (Char.isDigit ch)) s
 
     fun validHostUC s =
-       size s > 0 andalso size s < 30 andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"-") s
+       size s > 0 andalso size s < 30
+       andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"-") s
+       andalso CharVector.exists (fn ch => not (Char.isDigit ch)) s
 
     fun validVhostFilename s =
        case String.fields (fn ch => ch = #".") s of