intrinsic::readURL

--HG--
branch : com.mozilla.es4.smlnj
extra : convert_revision : 88450835f5590d4c4b010b0008113feb7d396040

builtins/Shell.es

@@ -39,6 +39,63 @@ package
     intrinsic native function print(x);
     intrinsic native function load(x);
     intrinsic native function readFile(x);
+    intrinsic native function readHTTP(server, port, file, method, headers);
+    intrinsic function readURL(url, method, headers) {
+        function eatLine(str, i) {
+            for (let j = i; j < str.length; j++) {
+                if (str[j] === '\n') {
+                    return [str.substring(i,j+1).trim(), j+1];
+                }
+            }
+            return [str.substring(i), str.length];
+        }
+        function eatHeaders(str, i) {
+            let result = {};
+            let line, j;
+            for ([line, j] = eatLine(str, i); j < str.length; [line, j] = eatLine(str, j)) {
+                if (line.trim() === "") {
+                    break;
+                }
+                let m = line.match(/(^[^:]+):(.*)/);
+                if (m === null) {
+                    throw ("couldn't parse HTTP header: " + line);
+                }
+                result[m[1].trim()] = m[2].trim();
+            }
+            return [result, j];
+        }
+        function parseStatus(text) {
+            let m = text.match(/^[^ ]+[ \t]+(\d+)[ \t]+(.*)/);
+            if (m === null) {
+                throw ("couldn't parse HTTP status: " + text);
+            }
+            return [uint(m[1].trim()), m[2].trim()];
+        }
+        function parseResponse(rsp) {
+            let [status, i] = eatLine(rsp,0);
+            let [headers, j] = eatHeaders(rsp,i);
+            let [statusCode, statusText] = parseStatus(status);
+            return ({ statusText: statusText,
+                      status: statusCode,
+                      headers: headers,
+                      responseText: rsp.substring(j) });
+        }
+        url = String(url);
+        method = String(method || "GET");
+        headers = headers || {};
+        let headerStr = "";
+        for (let key in headers) {
+            headerStr += String(key) + ": " + String(headers[key]) + "\r\n";
+        }
+        let matches = url.match(/(^http:\/\/)([^\/:]+)(?::(\d+))?(\/.*)?/);
+        if (matches === null) {
+            throw ("couldn't parse URL: " + url);
+        }
+        let server = String(matches[2]);
+        let port = uint(matches[3] || 80);
+        let page = String(matches[4] || "/");
+        return parseResponse(intrinsic::readHTTP(server, port, page, method, headerStr));
+    }
     intrinsic native function assert(x);
     intrinsic native function typename(x);
     intrinsic native function inspect(x, depth);

name.sml

@@ -146,6 +146,7 @@ val intrinsic_assert = intrinsic Ustring.assert_
 val intrinsic_typename = intrinsic Ustring.typename_
 val intrinsic_readFile = intrinsic Ustring.readFile_
 val intrinsic_writeFile = intrinsic Ustring.writeFile_
+val intrinsic_readHTTP = intrinsic Ustring.readHTTP_
 val intrinsic_explodeDouble = intrinsic Ustring.explodeDouble_
 
 (* From Function.es *)

native.sml

@@ -983,6 +983,66 @@ fun readFile (regs:Mach.REGS)
         Eval.newString regs (Ustring.fromString str)
     end
 
+fun readHTTP (regs:Mach.REGS)
+             (vals:Mach.VAL list)
+    : Mach.VAL =
+    let
+        val server = Ustring.toAscii (nthAsUstr vals 0)
+        val port = nthAsUInt regs vals 1
+        val page = Ustring.toAscii (nthAsUstr vals 2)
+        val method = Ustring.toAscii (nthAsUstr vals 3)
+        val headers = Ustring.toAscii (nthAsUstr vals 4)
+
+        fun str s = Eval.newString regs (Ustring.fromString s)
+
+        val addr = case NetHostDB.getByName server of
+                       SOME ip => INetSock.toAddr (NetHostDB.addr ip, Word32.toInt port)
+                     | NONE => raise Eval.ThrowException (str "unknown host")
+        val sock = INetSock.TCP.socket ()
+
+        fun close () =
+            Socket.close sock handle OS.SysErr _ => ()
+        fun throw s = (close(); raise Eval.ThrowException (str s))
+
+        val bufSize = 16384
+        val buf = Word8Array.array (bufSize, Word8.fromInt 0)
+
+        fun send s =
+            Socket.sendVec (sock, Word8VectorSlice.full (Byte.stringToBytes s))
+        fun recv () =
+            Socket.recvArr (sock, Word8ArraySlice.full buf)
+
+        fun slicePrefix n = Word8ArraySlice.slice (buf, 0, SOME n)
+        fun sliceSource slice =
+            let
+                fun cons (b, ls) = (Char.chr (Word8.toInt b))::ls
+                val chars = Word8ArraySlice.foldr cons [] slice
+            in
+                Ustring.fromSource (String.implode chars)
+            end
+
+        fun reader () : Ustring.SOURCE option =
+            (case recv () of
+                 0 => NONE
+               | bytesRead => SOME (sliceSource (slicePrefix bytesRead)))
+
+        fun readSrc (chunks:Ustring.SOURCE list)
+            : Ustring.SOURCE =
+            (case reader() of
+                 NONE => (close(); List.concat (List.rev chunks))
+               | SOME chunk => readSrc (chunk::chunks))
+    in
+        let
+            val _ = Socket.connect (sock, addr)
+            val _ = send (method ^ " " ^ page ^ " HTTP/1.0\r\n")
+            val _ = send headers
+            val _ = send "\r\n"
+        in
+            str (implode (map Ustring.wcharToChar (readSrc [])))
+        end
+        handle OS.SysErr (msg, _) => (close(); throw ("socket error: " ^ msg))
+    end
+
 fun writeFile (regs:Mach.REGS)
               (vals:Mach.VAL list)
     : Mach.VAL =
@@ -1170,6 +1230,7 @@ fun registerNatives _ =
         addFn 1 Name.intrinsic_load load;
         addFn 1 Name.intrinsic_readFile readFile;
         addFn 2 Name.intrinsic_writeFile writeFile;
+        addFn 5 Name.intrinsic_readHTTP readHTTP;
 
         addFn 1 Name.intrinsic_explodeDouble explodeDouble;
         addFn 1 Name.intrinsic_assert assert;

ustring.sml

@@ -294,6 +294,7 @@ val assert_                  = fromString "assert"
 val typename_                = fromString "typename"
 val readFile_                = fromString "readFile"
 val writeFile_               = fromString "writeFile"
+val readHTTP_                = fromString "readHTTP"
 val explodeDouble_           = fromString "explodeDouble"
 val Function_                = fromString "Function"
 val Boolean_                 = fromString "Boolean"