adding experimental --use-curl option

lib/chibi/snow/commands.scm

@@ -763,9 +763,37 @@
       (make-path (or (conf-get cfg 'host) "http://snow-fort.org")
                  path)))
 
+;; a subset of http-post functionality that can shell out to curl
+;; depending on config
+(define (snow-post cfg uri params)
+  (if (conf-get cfg 'use-curl?)
+      (let ((cmd `(curl --silent
+                        ,@(append-map
+                           (lambda (x)
+                             (cond
+                              ((and (pair? (cdr x)) (assq 'value (cdr x)))
+                               => (lambda (y)
+                                    `("-F" ,(string-append
+                                             (display-to-string (car x)) "="
+                                             (display-to-string (cdr y))))))
+                              ((and (pair? (cdr x)) (assq 'file (cdr x)))
+                               => (lambda (y)
+                                    `("-F" ,(string-append
+                                             (display-to-string (car x)) "=@"
+                                             (display-to-string (cdr y))))))
+                              (else
+                               `("-F" ,(string-append
+                                        (display-to-string (car x)) "="
+                                        (display-to-string (cdr x)))))))
+                           params)
+                        ,(uri->string uri))))
+        (open-input-bytevector (process->bytevector cmd)))
+      (http-post uri params)))
+
 (define (remote-command cfg name path params)
   (let ((uri (remote-uri cfg name path)))
-    (sxml-display-as-text (read (http-post uri (cons '(fmt . "sexp") params))))
+    (sxml-display-as-text
+     (read (snow-post cfg uri (cons '(fmt . "sexp") params))))
     (newline)))
 
 (define (command/reg-key cfg spec)

lib/chibi/snow/utils.scm

@@ -20,6 +20,11 @@
 (define (write-to-string x)
   (call-with-output-string (lambda (out) (write x out))))
 
+(define (display-to-string x)
+  (call-with-output-string
+    (lambda (out)
+      (if (bytevector? x) (write-bytevector x out) (display x out)))))
+
 (define (resource->bytevector uri)
   (let ((uri (if (uri? uri) uri (string->path-uri 'http uri))))
     (if (uri-host uri)

lib/chibi/snow/utils.sld

@@ -1,7 +1,8 @@
 
 (define-library (chibi snow utils)
   (export find-in-path find-sexp-in-path
-          write-to-string resource->bytevector uri-normalize uri-directory
+          write-to-string display-to-string
+          resource->bytevector uri-normalize uri-directory
           version-split version-compare version>? version>=?)
   (import (scheme base)
           (scheme file)

tools/snow-chibi

@@ -88,6 +88,7 @@
     (chibi-path filename "path to chibi-scheme executable")
     (cc string "path to c compiler")
     (cflags string "flags for c compiler")
+    (use-curl? boolean ("use-curl") "use curl for file uploads")
     (sexp? boolean ("sexp") "output information in sexp format")
     ))