Works now, mostly minimally complete

standardml · Oct 22, 2011 · 82dabdc · 82dabdc
1 parent b2145fe
commit 82dabdc
Show file tree

Hide file tree

Showing 6 changed files with 120 additions and 23 deletions.
diff --git a/Makefile b/Makefile
@@ -1,3 +1,21 @@
 
-mlton:
-	mlton -link-opt -lcurl smlcurl.mlb smlcurl.c 
+
+all: smlcurl fetchurl
+
+smlcurl:
+	mlton \
+	  -link-opt -lcurl \
+	  -cc-opt -Wall \
+	  -cc-opt -Wextra \
+	  smlcurl.mlb \
+	  smlcurl.c 
+
+fetchurl:
+	mlton \
+	  -link-opt -lcurl \
+	  -cc-opt -Wall \
+	  -cc-opt -Wextra \
+	  fetchurl.mlb \
+	  smlcurl.c 
+
+.PHONY: all smlcurl fetchurl
diff --git a/fetchurl.sml b/fetchurl.sml
@@ -1,2 +1,2 @@
 
-val _ = print (Curl.fetchURL "http://google.com")
+val _ = map (fn url => print (Curl.fetchURL url)) (CommandLine.arguments ())
diff --git a/smlcurl.c b/smlcurl.c
@@ -4,7 +4,6 @@
 #include <string.h>
 
 typedef struct handle_t {
-	bool inuse;
 	char *buffer;
 	size_t buffer_size;
 	enum { ERR_OK, ERR_OOM, ERR_OTHER } error;
@@ -43,7 +42,6 @@ smlcurl_collect_data (void *contents, size_t size, size_t nmemb, void *userp)
 struct handle_t *smlcurl_easy_init(void)
 {
 	handle_t *hdl = malloc(sizeof(handle_t));
-	hdl->inuse = true;
 	hdl->buffer = NULL;
 	hdl->buffer_size = 0;
 	hdl->error = ERR_OK;
@@ -74,7 +72,8 @@ int smlcurl_easy_set_signal(handle_t *hdl, bool signal)
 
 int smlcurl_easy_set_url(handle_t *hdl, const char *url)
 {
-	return curl_easy_setopt(hdl->curl, CURLOPT_URL, url);
+	int r= curl_easy_setopt(hdl->curl, CURLOPT_URL, url);
+	return r;
 }
 
 int smlcurl_easy_set_proxy(handle_t *hdl, const char *proxy)
@@ -87,19 +86,66 @@ int smlcurl_easy_set_useragent(handle_t *hdl, const char *useragent)
 	return curl_easy_setopt(hdl->curl, CURLOPT_USERAGENT, useragent);
 }
 
-void smlcurl_easy_perform_as_string(handle_t *hdl)
+int smlcurl_easy_perform_as_string(handle_t *hdl)
 {
-	  curl_easy_setopt(hdl, CURLOPT_WRITEFUNCTION, smlcurl_collect_data);
-	  curl_easy_setopt(hdl, CURLOPT_WRITEDATA, (void *)&hdl);
+	  curl_easy_setopt(hdl->curl, 
+	  	CURLOPT_WRITEFUNCTION, smlcurl_collect_data);
+	  curl_easy_setopt(hdl->curl, 
+	  	CURLOPT_WRITEDATA, (void *)hdl);
 	  curl_easy_perform(hdl->curl);
+	return 0;
 }
 
-const char *smlcurl_get_contents(handle_t *hdl)
+const char *smlcurl_easy_get_contents(handle_t *hdl)
 {
-	return hdl->buffer ? "" : hdl->buffer;
+	return hdl->buffer ? hdl->buffer : "";
 }
 
+const char *smlcurl_easy_get_effective_url(handle_t *hdl)
+{
+	char *ret;
+	int err=curl_easy_getinfo(hdl->curl, CURLINFO_EFFECTIVE_URL, &ret);
+
+	return ret;
+}
+
+int smlcurl_easy_get_response_code(handle_t *hdl)
+{
+	long ret;
+	int err=curl_easy_getinfo(hdl->curl, CURLINFO_RESPONSE_CODE, &ret);
+
+	return ret;
+}
+
+int smlcurl_easy_get_connect_code(handle_t *hdl)
+{
+	long ret;
+	int err=curl_easy_getinfo(hdl->curl, CURLINFO_HTTP_CONNECTCODE, &ret);
+
+	return ret;
+}
+
+double smlcurl_easy_get_total_time(handle_t *hdl)
+{
+	double ret;
+	int err=curl_easy_getinfo(hdl->curl, CURLINFO_TOTAL_TIME, &ret);
+
+	return ret;
+
+}
+
+const char * smlcurl_easy_get_content_type(handle_t *hdl)
+{
+	char *ret;
+	int err=curl_easy_getinfo(hdl->curl, CURLINFO_CONTENT_TYPE, &ret);
+
+	return ret ? ret : "";
+}
+
+
 void smlcurl_easy_cleanup(handle_t *hdl)
 {
-	curl_easy_cleanup(hdl);
+	free(hdl->buffer);
+	curl_easy_cleanup(hdl->curl);
 }
+
diff --git a/smlcurl.mlb b/smlcurl.mlb
@@ -2,6 +2,7 @@ $(SML_LIB)/basis/basis.mlb
 $(SML_LIB)/basis/mlton.mlb
 
 ann "allowFFI true" in
+ cstring-mlton.sml
  smlcurllowlevel.sml
 end
 

diff --git a/smlcurl.sml b/smlcurl.sml
@@ -13,6 +13,7 @@ structure Curl :> CURL =
 	    CurlFFI.curl_easy_set_progress hdl false;
 	    CurlFFI.curl_easy_set_url hdl url;
 	    CurlFFI.curl_easy_set_useragent hdl "smlcurl";
+	    CurlFFI.curl_easy_perform_as_string hdl;
 	    let 
 	       val contents = CurlFFI.curl_easy_get_contents hdl
 	    in

diff --git a/smlcurllowlevel.sml b/smlcurllowlevel.sml
@@ -12,13 +12,18 @@ signature CURLFFI =
       val curl_easy_set_useragent : hdl -> string -> unit
       val curl_easy_perform_as_string : hdl -> unit
       val curl_easy_get_contents : hdl -> string
+      val curl_easy_get_effective_url : hdl -> string
+      val curl_easy_get_response_code : hdl -> int
+      val curl_easy_get_connect_code : hdl -> int
+      val curl_easy_get_total_time : hdl -> real
+      val curl_easy_get_content_type : hdl -> string
       val curl_easy_cleanup : hdl -> unit
     end
 
 structure CurlFFI :> CURLFFI =
    struct
       type hdl = MLton.Pointer.t
-      type cstr = MLton.Pointer.t
+      type cstr = CString.p
 
 (* Raw API, We'll build the public API out of this *)
       val curl_easy_init_raw =
@@ -57,16 +62,31 @@ structure CurlFFI :> CURLFFI =
       val curl_easy_cleanup_raw =
         _import "smlcurl_easy_cleanup" : hdl -> unit;
 
+      val curl_easy_get_effective_url_raw =
+        _import "smlcurl_easy_get_effective_url" : hdl -> cstr;
+
+      val curl_easy_get_response_code_raw =
+        _import "curl_easy_get_response_code" : hdl -> int;
+
+      val curl_easy_get_connect_code_raw =
+        _import "curl_easy_get_connect_code" : hdl -> int;
+
+      val curl_easy_get_total_time_raw =
+        _import "curl_easy_get_total_time" : hdl -> real;
+
+      val curl_easy_get_content_type_raw =
+        _import "curl_easy_get_content_type" : hdl -> cstr;
+
 (* Helper functions *)
       fun fail_on_error 0 = ()
         | fail_on_error x = raise Fail ("Unexpected curl error #" ^ (Int.toString x))
 	;
 
-      val string_to_cstr : string -> cstr = fn _ => raise Fail "Unimplemented"
-        ;
+      fun cstr_to_string cstr = CString.toString (CString.fromPointer cstr)
 
-      val cstr_to_string : cstr -> string = fn _ => raise Fail "Unimplemented"
-        ;
+      fun call_with_cstr f hdl str 
+        = CString.app (fn cstr => f (hdl, cstr)) (CString.fromString str)
+
 
 (* The public API *)
       val curl_easy_init = curl_easy_init_raw;
@@ -81,18 +101,29 @@ structure CurlFFI :> CURLFFI =
         = fail_on_error (curl_easy_set_progress_raw (hdl, flag))
 
       fun curl_easy_set_url hdl value 
-        = fail_on_error (curl_easy_set_url_raw (hdl, string_to_cstr (value)))
+        = fail_on_error (call_with_cstr curl_easy_set_url_raw hdl value)
       fun curl_easy_set_proxy hdl value 
-        = fail_on_error (curl_easy_set_proxy_raw (hdl, string_to_cstr (value)))
+        = fail_on_error (call_with_cstr curl_easy_set_proxy_raw hdl value)
       fun curl_easy_set_useragent hdl value 
-        = fail_on_error (curl_easy_set_useragent_raw (
-			    hdl, string_to_cstr (value)))
+        = fail_on_error (call_with_cstr curl_easy_set_useragent_raw hdl value)
 
       fun curl_easy_perform_as_string hdl 
         = fail_on_error (curl_easy_perform_as_string_raw (hdl))
 
-      fun curl_easy_get_contents hdl = 
-        cstr_to_string (curl_easy_get_contents_raw hdl)
+      fun curl_easy_get_contents hdl
+        = cstr_to_string (curl_easy_get_contents_raw hdl)
+
+      fun curl_easy_get_effective_url hdl
+        = cstr_to_string (curl_easy_get_effective_url_raw hdl)
+
+      val curl_easy_get_response_code = curl_easy_get_response_code_raw; 
+
+      val curl_easy_get_connect_code = curl_easy_get_connect_code_raw;
+
+      val curl_easy_get_total_time = curl_easy_get_total_time_raw;
+
+      fun curl_easy_get_content_type hdl
+        = cstr_to_string (curl_easy_get_content_type_raw hdl)
 
       fun curl_easy_cleanup hdl = curl_easy_cleanup_raw hdl