Add download-file library
This commit is contained in:
parent
f6a0cdc6cb
commit
6db4653a97
|
|
@ -12,18 +12,18 @@ pipeline {
|
|||
buildDiscarder(logRotator(numToKeepStr: '10', artifactNumToKeepStr: '10'))
|
||||
}
|
||||
|
||||
parameters {
|
||||
string(name: 'R7RS_SCHEMES', defaultValue: 'chibi chicken gauche guile kawa mosh racket sagittarius stklos ypsilon', description: '')
|
||||
string(name: 'R6RS_SCHEMES', defaultValue: 'chezscheme guile ikarus ironscheme mosh racket sagittarius ypsilon', description: '')
|
||||
string(name: 'LIBRARIES', defaultValue: 'system named-pipes shell requests', description: '')
|
||||
environment {
|
||||
R7RS_SCHEMES='chibi chicken gauche guile kawa mosh racket sagittarius stklos ypsilon'
|
||||
R6RS_SCHEMES='chezscheme guile ikarus ironscheme mosh racket sagittarius ypsilon'
|
||||
LIBRARIES='system named-pipes shell download-file'
|
||||
}
|
||||
|
||||
stages {
|
||||
stage('Test R6RS Debian') {
|
||||
steps {
|
||||
script {
|
||||
params.LIBRARIES.split().each { LIBRARY ->
|
||||
params.R6RS_SCHEMES.split().each { SCHEME ->
|
||||
env.LIBRARIES.split().each { LIBRARY ->
|
||||
env.R6RS_SCHEMES.split().each { SCHEME ->
|
||||
stage("${SCHEME} ${LIBRARY}") {
|
||||
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
|
||||
sh "make SCHEME=${SCHEME} LIBRARY=${LIBRARY} RNRS=r6rs test-docker"
|
||||
|
|
@ -37,8 +37,8 @@ pipeline {
|
|||
stage('Test R7RS Debian') {
|
||||
steps {
|
||||
script {
|
||||
params.LIBRARIES.split().each { LIBRARY ->
|
||||
params.R7RS_SCHEMESsplit().each { SCHEME ->
|
||||
env.LIBRARIES.split().each { LIBRARY ->
|
||||
env.R7RS_SCHEMESsplit().each { SCHEME ->
|
||||
stage("${SCHEME} ${LIBRARY}") {
|
||||
catchError(buildResult: 'SUCCESS', stageResult: 'FAILURE') {
|
||||
sh "make SCHEME=${SCHEME} LIBRARY=${LIBRARY} RNRS=r7rs test-docker"
|
||||
|
|
|
|||
1
Makefile
1
Makefile
|
|
@ -68,6 +68,7 @@ test-docker: testfiles
|
|||
CSC_OPTIONS="${CSC_OPTIONS}" \
|
||||
SNOW_PACKAGES="foreign.c srfi.64 srfi.170 retropikzel.system retropikzel.named-pipes ${PKG}" \
|
||||
APT_PACKAGES="${APT_PACKAGES}" \
|
||||
PASS_ENV_VARS="CSC_OPTIONS" \
|
||||
test-r7rs -o test-program test.${SFX}
|
||||
|
||||
clean:
|
||||
|
|
|
|||
|
|
@ -0,0 +1,63 @@
|
|||
(define CURLOPT-POSTFIELDSIZE 60)
|
||||
(define CURLOPT-POSTFIELDS 10015)
|
||||
(define CURLOPT-URL 10002)
|
||||
(define CURLOPT-HTTPHEADER 10023)
|
||||
(define CURLOPT-WRITEDATA 10001)
|
||||
(define CURLOPT-WRITEFUNCTION 20011)
|
||||
(define CURLOPT-CUSTOMREQUEST 10036)
|
||||
(define CURLOPT-COOKIE 10022)
|
||||
(define CURLOPT-COOKIEFILE 10031)
|
||||
(define CURLOPT-COOKIEJAR 10082)
|
||||
(define CURLINFO-RESPONSE-CODE 2097154)
|
||||
(define CURLHE-BADINDEX 1)
|
||||
(define CURLHE-HEADER 1)
|
||||
(define CURLINFO-COOKIELIST 4194332)
|
||||
(define randomized? #f)
|
||||
|
||||
(define-c-library libc '("stdlib.h" "stdio.h" "time.h") #f '())
|
||||
(define-c-procedure c-fopen libc 'fopen 'pointer '(pointer pointer))
|
||||
(define-c-procedure c-fclose libc 'fclose 'int '(pointer))
|
||||
(define-c-procedure c-perror libc 'perror 'void '(pointer))
|
||||
|
||||
(define-c-library libcurl '("curl/curl.h") "curl" '((additional-versions ("4"))))
|
||||
(define-c-procedure curl-easy-init libcurl 'curl_easy_init 'pointer '())
|
||||
(define-c-procedure curl-easy-cleanup libcurl 'curl_easy_cleanup 'void '(pointer))
|
||||
(define-c-procedure curl-easy-setopt-pointer libcurl 'curl_easy_setopt 'int '(pointer int pointer))
|
||||
(define-c-procedure curl-easy-setopt-int libcurl 'curl_easy_setopt 'int '(pointer int int))
|
||||
;(define-c-procedure curl-slist-append libcurl 'curl_slist_append 'pointer '(pointer pointer))
|
||||
(define-c-procedure curl-easy-strerror libcurl 'curl_easy_strerror 'pointer '(int))
|
||||
(define-c-procedure curl-easy-perform libcurl 'curl_easy_perform 'int '(pointer))
|
||||
;(define-c-procedure curl-easy-getinfo libcurl 'curl_easy_getinfo 'int '(pointer int pointer))
|
||||
;(define-c-procedure curl-easy-nextheader libcurl 'curl_easy_nextheader 'pointer '(pointer int int pointer))
|
||||
|
||||
|
||||
(define (download-file url . download-path)
|
||||
(when (not (string? url))
|
||||
(error "download-file error: url must be string" url))
|
||||
(when (and (not (null? download-path))
|
||||
(not (string? (car download-path))))
|
||||
(error "download-file error: download-path must be string"
|
||||
(car download-path)))
|
||||
(let* ((handle (curl-easy-init))
|
||||
(to-path (if (null? download-path) "." (car download-path)))
|
||||
(to-path-cbv (string->c-bytevector to-path))
|
||||
(file-mode-cbv (string->c-bytevector "w"))
|
||||
(to-file-cbv (c-fopen to-path-cbv file-mode-cbv))
|
||||
(url-cbv (string->c-bytevector url)))
|
||||
(when (c-bytevector-null? to-file-cbv)
|
||||
(let* ((error-message "download-file error")
|
||||
(error-pointer (string->c-bytevector error-message)))
|
||||
(c-perror error-pointer)
|
||||
(c-bytevector-free file-mode-cbv to-path-cbv o-file-cbv url-cbv error-pointer)
|
||||
(error error-message)))
|
||||
(curl-easy-setopt-pointer handle CURLOPT-WRITEDATA to-file-cbv)
|
||||
(curl-easy-setopt-pointer handle CURLOPT-URL url-cbv)
|
||||
(let ((result (curl-easy-perform handle)))
|
||||
(when (not (= result 0))
|
||||
(let* ((error-cbv (curl-easy-strerror result))
|
||||
(error-string (c-bytevector->string error-cbv)))
|
||||
(c-bytevector-free error-cbv)
|
||||
(error error-string url)))
|
||||
(curl-easy-cleanup handle)
|
||||
;(c-bytevector-free file-mode-cbv to-path-cbv to-file-cbv url-cbv)
|
||||
)))
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
(define-library
|
||||
(retropikzel download-file)
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme char)
|
||||
(scheme file)
|
||||
(scheme process-context)
|
||||
(foreign c))
|
||||
(export download-file)
|
||||
(include "download-file.scm"))
|
||||
|
|
@ -0,0 +1 @@
|
|||
-L -lcurl
|
||||
|
|
@ -0,0 +1,165 @@
|
|||
GNU LESSER GENERAL PUBLIC LICENSE
|
||||
Version 3, 29 June 2007
|
||||
|
||||
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
|
||||
This version of the GNU Lesser General Public License incorporates
|
||||
the terms and conditions of version 3 of the GNU General Public
|
||||
License, supplemented by the additional permissions listed below.
|
||||
|
||||
0. Additional Definitions.
|
||||
|
||||
As used herein, "this License" refers to version 3 of the GNU Lesser
|
||||
General Public License, and the "GNU GPL" refers to version 3 of the GNU
|
||||
General Public License.
|
||||
|
||||
"The Library" refers to a covered work governed by this License,
|
||||
other than an Application or a Combined Work as defined below.
|
||||
|
||||
An "Application" is any work that makes use of an interface provided
|
||||
by the Library, but which is not otherwise based on the Library.
|
||||
Defining a subclass of a class defined by the Library is deemed a mode
|
||||
of using an interface provided by the Library.
|
||||
|
||||
A "Combined Work" is a work produced by combining or linking an
|
||||
Application with the Library. The particular version of the Library
|
||||
with which the Combined Work was made is also called the "Linked
|
||||
Version".
|
||||
|
||||
The "Minimal Corresponding Source" for a Combined Work means the
|
||||
Corresponding Source for the Combined Work, excluding any source code
|
||||
for portions of the Combined Work that, considered in isolation, are
|
||||
based on the Application, and not on the Linked Version.
|
||||
|
||||
The "Corresponding Application Code" for a Combined Work means the
|
||||
object code and/or source code for the Application, including any data
|
||||
and utility programs needed for reproducing the Combined Work from the
|
||||
Application, but excluding the System Libraries of the Combined Work.
|
||||
|
||||
1. Exception to Section 3 of the GNU GPL.
|
||||
|
||||
You may convey a covered work under sections 3 and 4 of this License
|
||||
without being bound by section 3 of the GNU GPL.
|
||||
|
||||
2. Conveying Modified Versions.
|
||||
|
||||
If you modify a copy of the Library, and, in your modifications, a
|
||||
facility refers to a function or data to be supplied by an Application
|
||||
that uses the facility (other than as an argument passed when the
|
||||
facility is invoked), then you may convey a copy of the modified
|
||||
version:
|
||||
|
||||
a) under this License, provided that you make a good faith effort to
|
||||
ensure that, in the event an Application does not supply the
|
||||
function or data, the facility still operates, and performs
|
||||
whatever part of its purpose remains meaningful, or
|
||||
|
||||
b) under the GNU GPL, with none of the additional permissions of
|
||||
this License applicable to that copy.
|
||||
|
||||
3. Object Code Incorporating Material from Library Header Files.
|
||||
|
||||
The object code form of an Application may incorporate material from
|
||||
a header file that is part of the Library. You may convey such object
|
||||
code under terms of your choice, provided that, if the incorporated
|
||||
material is not limited to numerical parameters, data structure
|
||||
layouts and accessors, or small macros, inline functions and templates
|
||||
(ten or fewer lines in length), you do both of the following:
|
||||
|
||||
a) Give prominent notice with each copy of the object code that the
|
||||
Library is used in it and that the Library and its use are
|
||||
covered by this License.
|
||||
|
||||
b) Accompany the object code with a copy of the GNU GPL and this license
|
||||
document.
|
||||
|
||||
4. Combined Works.
|
||||
|
||||
You may convey a Combined Work under terms of your choice that,
|
||||
taken together, effectively do not restrict modification of the
|
||||
portions of the Library contained in the Combined Work and reverse
|
||||
engineering for debugging such modifications, if you also do each of
|
||||
the following:
|
||||
|
||||
a) Give prominent notice with each copy of the Combined Work that
|
||||
the Library is used in it and that the Library and its use are
|
||||
covered by this License.
|
||||
|
||||
b) Accompany the Combined Work with a copy of the GNU GPL and this license
|
||||
document.
|
||||
|
||||
c) For a Combined Work that displays copyright notices during
|
||||
execution, include the copyright notice for the Library among
|
||||
these notices, as well as a reference directing the user to the
|
||||
copies of the GNU GPL and this license document.
|
||||
|
||||
d) Do one of the following:
|
||||
|
||||
0) Convey the Minimal Corresponding Source under the terms of this
|
||||
License, and the Corresponding Application Code in a form
|
||||
suitable for, and under terms that permit, the user to
|
||||
recombine or relink the Application with a modified version of
|
||||
the Linked Version to produce a modified Combined Work, in the
|
||||
manner specified by section 6 of the GNU GPL for conveying
|
||||
Corresponding Source.
|
||||
|
||||
1) Use a suitable shared library mechanism for linking with the
|
||||
Library. A suitable mechanism is one that (a) uses at run time
|
||||
a copy of the Library already present on the user's computer
|
||||
system, and (b) will operate properly with a modified version
|
||||
of the Library that is interface-compatible with the Linked
|
||||
Version.
|
||||
|
||||
e) Provide Installation Information, but only if you would otherwise
|
||||
be required to provide such information under section 6 of the
|
||||
GNU GPL, and only to the extent that such information is
|
||||
necessary to install and execute a modified version of the
|
||||
Combined Work produced by recombining or relinking the
|
||||
Application with a modified version of the Linked Version. (If
|
||||
you use option 4d0, the Installation Information must accompany
|
||||
the Minimal Corresponding Source and Corresponding Application
|
||||
Code. If you use option 4d1, you must provide the Installation
|
||||
Information in the manner specified by section 6 of the GNU GPL
|
||||
for conveying Corresponding Source.)
|
||||
|
||||
5. Combined Libraries.
|
||||
|
||||
You may place library facilities that are a work based on the
|
||||
Library side by side in a single library together with other library
|
||||
facilities that are not Applications and are not covered by this
|
||||
License, and convey such a combined library under terms of your
|
||||
choice, if you do both of the following:
|
||||
|
||||
a) Accompany the combined library with a copy of the same work based
|
||||
on the Library, uncombined with any other library facilities,
|
||||
conveyed under the terms of this License.
|
||||
|
||||
b) Give prominent notice with the combined library that part of it
|
||||
is a work based on the Library, and explaining where to find the
|
||||
accompanying uncombined form of the same work.
|
||||
|
||||
6. Revised Versions of the GNU Lesser General Public License.
|
||||
|
||||
The Free Software Foundation may publish revised and/or new versions
|
||||
of the GNU Lesser General Public License from time to time. Such new
|
||||
versions will be similar in spirit to the present version, but may
|
||||
differ in detail to address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the
|
||||
Library as you received it specifies that a certain numbered version
|
||||
of the GNU Lesser General Public License "or any later version"
|
||||
applies to it, you have the option of following the terms and
|
||||
conditions either of that published version or of any later version
|
||||
published by the Free Software Foundation. If the Library as you
|
||||
received it does not specify a version number of the GNU Lesser
|
||||
General Public License, you may choose any version of the GNU Lesser
|
||||
General Public License ever published by the Free Software Foundation.
|
||||
|
||||
If the Library as you received it specifies that a proxy can decide
|
||||
whether future versions of the GNU Lesser General Public License shall
|
||||
apply, that proxy's public statement of acceptance of any version is
|
||||
permanent authorization for you to choose that version for the
|
||||
Library.
|
||||
|
|
@ -0,0 +1 @@
|
|||
Download file
|
||||
|
|
@ -0,0 +1 @@
|
|||
0.1.0
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
(test-begin "download-file")
|
||||
|
||||
(define tmpfile "/tmp/download-file-test-file.json")
|
||||
(when (file-exists? tmpfile) (delete-file tmpfile))
|
||||
(download-file "https://microsoftedge.github.io/Demos/json-dummy-data/64KB.json"
|
||||
tmpfile)
|
||||
(test-assert (file-exists? tmpfile))
|
||||
|
||||
(test-end "download-file")
|
||||
|
||||
Loading…
Reference in New Issue