57 lines
2.1 KiB
Scheme
57 lines
2.1 KiB
Scheme
(import (scheme base)
|
|
(scheme write)
|
|
(scheme process-context)
|
|
(retropikzel r7rs-pffi v0-4-0 main))
|
|
|
|
(define libcurl (pffi-shared-object-auto-load (list "curl/curl.h") ; Headers
|
|
(list ".") ; Additional search paths
|
|
"curl" ; The named of shared object without the lib prefix
|
|
(list ".4"))) ;Additional versions to search
|
|
|
|
(pffi-define curl-easy-init libcurl 'curl_easy_init 'pointer (list))
|
|
|
|
; Define the curl-easy-setopt twice since some implementations (Sagittarius) complain if you pass
|
|
; callback type instead of pointer type
|
|
(pffi-define curl-easy-setopt libcurl 'curl_easy_setopt 'int (list 'pointer 'int 'pointer))
|
|
(pffi-define curl-easy-setopt-callback libcurl 'curl_easy_setopt 'int (list 'pointer 'int 'callback))
|
|
|
|
(pffi-define curl-easy-perform libcurl 'curl_easy_perform 'int (list 'pointer))
|
|
|
|
;These values need to be get from c file like this:
|
|
; #include <curl/curl.h>
|
|
; int main() {
|
|
; printf("Value: %d", CURLOPT_WRITEFUNCTION);
|
|
; }
|
|
; many times you can get them from .h files directly
|
|
(define CURLOPT-WRITEFUNCTION 20011)
|
|
(define CURLOPT-FOLLOWLOCATION 52)
|
|
(define CURLOPT-URL 10002)
|
|
|
|
(define result "")
|
|
(pffi-define-callback collect-result
|
|
'void
|
|
(list 'pointer 'int 'int 'pointer)
|
|
(lambda (pointer size nmemb client-pointer)
|
|
(set! result (string-append result (pffi-pointer->string pointer)))))
|
|
|
|
(define handle (curl-easy-init))
|
|
(define url (pffi-string->pointer "https://scheme.org"))
|
|
(define curl-code1 (curl-easy-setopt handle CURLOPT-FOLLOWLOCATION url))
|
|
(define curl-code2 (curl-easy-setopt handle CURLOPT-URL url))
|
|
(define curl-code3 (curl-easy-setopt-callback handle CURLOPT-WRITEFUNCTION collect-result))
|
|
(display "Curl code 1: ")
|
|
(display curl-code1)
|
|
(newline)
|
|
(display "Curl code 2: ")
|
|
(display curl-code2)
|
|
(newline)
|
|
(display "Curl code 3: ")
|
|
(display curl-code3)
|
|
(newline)
|
|
(display "Perform: ")
|
|
(write (curl-easy-perform handle))
|
|
(newline)
|
|
(display "Response length: ")
|
|
(display (string-length result))
|
|
(newline)
|