use curl for GET as well as POST in snow (i(issue #549)

This commit is contained in:
Alex Shinn 2020-08-25 15:21:25 +09:00
parent 60c4007e6f
commit 0a503dc3ad
3 changed files with 8 additions and 4 deletions

View file

@ -1168,7 +1168,7 @@
(local-tmp (string-append local-path ".tmp." (local-tmp (string-append local-path ".tmp."
(number->string (current-second)) "-" (number->string (current-second)) "-"
(number->string (current-process-id)))) (number->string (current-process-id))))
(repo-str (utf8->string (resource->bytevector repo-uri))) (repo-str (utf8->string (resource->bytevector cfg repo-uri)))
(repo (guard (exn (else #f)) (repo (guard (exn (else #f))
(let ((repo (read (open-input-string repo-str)))) (let ((repo (read (open-input-string repo-str))))
`(,(car repo) (url ,repo-uri) ,@(cdr repo)))))) `(,(car repo) (url ,repo-uri) ,@(cdr repo))))))
@ -2128,7 +2128,7 @@
(install-file cfg (make-path dir src) dest))) (install-file cfg (make-path dir src) dest)))
(define (fetch-package cfg url) (define (fetch-package cfg url)
(resource->bytevector url)) (resource->bytevector cfg url))
(define (path-strip-top file) (define (path-strip-top file)
(let ((pos (string-find file #\/))) (let ((pos (string-find file #\/)))

View file

@ -25,10 +25,12 @@
(lambda (out) (lambda (out)
(if (bytevector? x) (write-bytevector x out) (display x out))))) (if (bytevector? x) (write-bytevector x out) (display x out)))))
(define (resource->bytevector uri) (define (resource->bytevector cfg uri)
(let ((uri (if (uri? uri) uri (string->path-uri 'http uri)))) (let ((uri (if (uri? uri) uri (string->path-uri 'http uri))))
(if (uri-host uri) (if (uri-host uri)
(call-with-input-url uri port->bytevector) (if (conf-get cfg 'use-curl?)
(process->bytevector `(curl --silent ,(uri->string uri)))
(call-with-input-url uri port->bytevector))
(file->bytevector (uri-path uri))))) (file->bytevector (uri-path uri)))))
;; path-normalize either a uri or path, and return the result as a string ;; path-normalize either a uri or path, and return the result as a string

View file

@ -11,8 +11,10 @@
(scheme write) (scheme write)
(scheme process-context) (scheme process-context)
(srfi 1) (srfi 1)
(chibi config)
(chibi net http) (chibi net http)
(chibi pathname) (chibi pathname)
(chibi process)
(chibi string) (chibi string)
(chibi uri)) (chibi uri))
(cond-expand (cond-expand