├── .gitignore ├── test.l ├── .travis.yml ├── test ├── test_regressions.l └── test_https.l ├── module.l ├── LICENSE ├── local.l ├── Makefile ├── CHANGELOG.md ├── https.l ├── ffi.l ├── internal.l ├── README.md └── EXPLAIN.md /.gitignore: -------------------------------------------------------------------------------- 1 | .lib/ 2 | .modules/ 3 | -------------------------------------------------------------------------------- /test.l: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env pil 2 | 3 | (load ".modules/picolisp-unit/HEAD/unit.l") 4 | 5 | (load "https.l") 6 | 7 | (prinl "^J Testing HTTP(S) client for PicoLisp^J") 8 | 9 | (symbols 'https) 10 | 11 | (chdir "test/" 12 | (mapcar load (filter '((N) (sub? "test_" N)) (dir "."))) ) 13 | 14 | (unit~report) 15 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: bash 2 | sudo: false 3 | cache: apt 4 | 5 | before_script: 6 | - make 7 | - wget http://software-lab.de/picoLisp-16.12.tgz -O /tmp/picolisp.tgz 8 | - cd /tmp; tar -xf /tmp/picolisp.tgz 9 | - cd /tmp/picoLisp/src64 && make 10 | 11 | script: 12 | - export PATH=$PATH:/tmp/picoLisp 13 | - cd ${TRAVIS_BUILD_DIR} && make check 14 | -------------------------------------------------------------------------------- /test/test_regressions.l: -------------------------------------------------------------------------------- 1 | # Regression tests 2 | 3 | # Download files fails - https://github.com/aw/picolisp-https/issues/5 4 | [de test-gh-issue-5 () 5 | (unit~assert-throws 6 | 'InternalError 7 | '(HttpsError . "Unable to write to file: /dev/non-existant-file") 8 | '(download-file NIL "/dev/non-existant-file") 9 | "Regression test GH issue #5 - download file fails" ] 10 | 11 | [unit~execute 12 | '(test-gh-issue-5) ] 13 | -------------------------------------------------------------------------------- /module.l: -------------------------------------------------------------------------------- 1 | [de MODULE_INFO 2 | ("name" "https") 3 | ("version" "0.30.1.12") 4 | ("summary" "HTTP(S) client for PicoLisp") 5 | ("source" "https://github.com/aw/picolisp-https.git") 6 | ("author" "Alexander Williams") 7 | ("license" "MIT") 8 | ("copyright" "(c) 2015 Alexander Williams, Unscramble ") 9 | ("install" "make") 10 | ("requires" 11 | ("picolisp-unit" "v1.0.0" "https://github.com/aw/picolisp-unit.git") 12 | ("neon" "0.30.1" "https://github.com/aw/neon-unofficial-mirror.git") ] 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Alexander Williams, Unscramble 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /local.l: -------------------------------------------------------------------------------- 1 | # local.l 2 | # 3 | # The MIT License (MIT) 4 | # 5 | # Copyright (c) 2015 Alexander Williams, Unscramble 6 | 7 | (local MODULE_INFO *Https *Buffer_size *Headers) 8 | (local *NE_FEATURE_SSL *NE_FEATURE_ZLIB *NE_FEATURE_IPV6 *NE_FEATURE_LFS *NE_FEATURE_SOCKS) 9 | (local *NE_FEATURE_TS_SSL *NE_FEATURE_I18N *NE_FEATURE_SSPI) 10 | (local *NE_ABUFSIZ *NE_OK *NE_ERROR *NE_LOOKUP *NE_AUTH *NE_PROXYAUTH *NE_CONNECT) 11 | (local *NE_TIMEOUT *NE_FAILED *NE_RETRY *NE_REDIRECT) 12 | 13 | # ffi 14 | (local ne-sock-init ne-version-string ne-has-support ne-get-error ne-uri-parse ne-uri-defaultport) 15 | (local ne-add-request-header ne-session-create ne-ssl-trust-default-ca ne-request-create) 16 | (local ne-begin-request ne-end-request ne-read-response-block ne-read-response-to-fd ne-set-request-body-buffer) 17 | (local ne-request-destroy ne-close-connection ne-session-destroy ne-get-status ne-response-header-iterate) 18 | (local ne-set-server-auth ne-forget-auth) 19 | 20 | # internal 21 | (local throw-error create-session-request create-session parse-uri get-port set-auth-credentials) 22 | (local do-auth del-auth-credentials set-headers set-request-body request-dispatch download-file random-filename random-id) 23 | (local process-body link-response-block pack-body parse-response get-headers end-request-session end-session) 24 | (local begin-request end-request) 25 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Makefile 2 | 3 | PIL_MODULE_DIR ?= .modules 4 | PIL_SYMLINK_DIR ?= .lib 5 | 6 | ## Edit below 7 | BUILD_REPO = https://github.com/aw/neon-unofficial-mirror.git 8 | BUILD_DIR = $(PIL_MODULE_DIR)/neon/HEAD 9 | BUILD_REF = 0.30.1 10 | LIB_DIR = src/.libs 11 | TARGET = libneon.so 12 | BFLAGS = --enable-shared --with-ssl=openssl --enable-threadsafe-ssl=posix 13 | ## Edit above 14 | 15 | # Unit testing 16 | TEST_REPO = https://github.com/aw/picolisp-unit.git 17 | TEST_DIR = $(PIL_MODULE_DIR)/picolisp-unit/HEAD 18 | 19 | # Generic 20 | COMPILE = make 21 | 22 | .PHONY: all clean 23 | 24 | all: $(BUILD_DIR) $(BUILD_DIR)/$(LIB_DIR)/$(TARGET) symlink 25 | 26 | $(BUILD_DIR): 27 | mkdir -p $(BUILD_DIR) && \ 28 | git clone $(BUILD_REPO) $(BUILD_DIR) 29 | 30 | $(TEST_DIR): 31 | mkdir -p $(TEST_DIR) && \ 32 | git clone $(TEST_REPO) $(TEST_DIR) 33 | 34 | $(BUILD_DIR)/$(LIB_DIR)/$(TARGET): 35 | cd $(BUILD_DIR) && \ 36 | git checkout $(BUILD_REF) && \ 37 | ./autogen.sh && \ 38 | ./configure $(BFLAGS) && \ 39 | $(COMPILE) && \ 40 | strip --strip-unneeded $(LIB_DIR)/$(TARGET) 41 | 42 | symlink: 43 | mkdir -p $(PIL_SYMLINK_DIR) && \ 44 | cd $(PIL_SYMLINK_DIR) && \ 45 | ln -sf ../$(BUILD_DIR)/$(LIB_DIR)/$(TARGET) $(TARGET) 46 | 47 | check: all $(TEST_DIR) run-tests 48 | 49 | run-tests: 50 | ./test.l 51 | 52 | clean: 53 | cd $(BUILD_DIR)/$(LIB_DIR) && \ 54 | rm -f $(TARGET) && \ 55 | cd - && \ 56 | cd $(PIL_SYMLINK_DIR) && \ 57 | rm -f $(TARGET) 58 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | ## 0.30.1.12 (2015-06-15) 4 | 5 | * Update picolisp-unit to v1.0.0 6 | 7 | ## 0.30.1.11 (2015-04-28) 8 | 9 | * Remove the need for git submodules 10 | * Add Makefile for fetching and building dependencies 11 | * Change default path for dependencies and shared module (.modules and .lib) 12 | * Adjust README.md, tests and travis-ci unit testing config 13 | 14 | ## 0.30.1.10 (2015-04-22) 15 | 16 | * Fix bug where downloading a file to an inexistant dir fails horribly 17 | 18 | ## 0.30.1.9 (2015-04-12) 19 | 20 | * Update picolisp-unit to v0.6.1 21 | 22 | ## 0.30.1.8 (2015-04-08) 23 | 24 | * Update picolisp-unit to v0.6.0 25 | * Add requires to module.l 26 | 27 | ## 0.30.1.7 (2015-03-31) 28 | 29 | * Update picolisp-unit to v0.5.2 30 | 31 | ## 0.30.1.6 (2015-03-24) 32 | 33 | * Add unit tests and automated testing with travis-ci 34 | * Move MODULE_INFO to module.l 35 | * Update README.md 36 | * Prevent leaky namespace globals 37 | * Add update.sh script 38 | 39 | ## 0.30.1.5 (2015-03-17) 40 | 41 | * Version bump because it's 3am. I should sleep. 42 | 43 | ## 0.30.1.4 (2015-03-17) 44 | 45 | * Add an incrementing counter to temporary filenames, to prevent collisions 46 | * Fix noop in (cons) pair 47 | (credit: Alexander Burger) 48 | 49 | ## 0.30.1.3 (2015-03-17) 50 | 51 | * Documentation updates 52 | 53 | ## 0.30.1.2 (2015-03-16) 54 | 55 | * Ensure the upload buffer (malloc) is free'd even if an error is thrown 56 | -------------------------------------------------------------------------------- /https.l: -------------------------------------------------------------------------------- 1 | # https.l 2 | # 3 | # The MIT License (MIT) 4 | # 5 | # Copyright (c) 2015 Alexander Williams, Unscramble 6 | 7 | (symbols 'https 'pico) 8 | 9 | (load (pack (car (file)) "local.l")) 10 | 11 | (load (pack (car (file)) "module.l")) 12 | 13 | (setq 14 | *Https (pack (car (file)) ".lib/libneon.so") 15 | *Buffer_size 8192 16 | *Headers '(("Accept" . "*/*") 17 | ("Accept-Charset" . "utf-8") 18 | ("User-Agent" . "picolisp-https") ) 19 | 20 | *NE_FEATURE_SSL 1 21 | *NE_FEATURE_ZLIB 2 22 | *NE_FEATURE_IPV6 3 23 | *NE_FEATURE_LFS 4 24 | *NE_FEATURE_SOCKS 5 25 | *NE_FEATURE_TS_SSL 6 26 | *NE_FEATURE_I18N 7 27 | *NE_FEATURE_SSPI 8 28 | 29 | *NE_ABUFSIZ 256 30 | 31 | *NE_OK 0 32 | *NE_ERROR 1 33 | *NE_LOOKUP 2 34 | *NE_AUTH 3 35 | *NE_PROXYAUTH 4 36 | *NE_CONNECT 5 37 | *NE_TIMEOUT 6 38 | *NE_FAILED 7 39 | *NE_RETRY 8 40 | *NE_REDIRECT 9 ) 41 | 42 | # ffi-bindings 43 | (load (pack (car (file)) "ffi.l")) 44 | 45 | # internal 46 | (load (pack (car (file)) "internal.l")) 47 | 48 | # initialize 49 | (when (=0 (ne-has-support *NE_FEATURE_SSL)) 50 | (throw-error NIL "Missing support for SSL/TLS") ) 51 | 52 | (when (=0 (ne-has-support *NE_FEATURE_TS_SSL)) 53 | (throw-error NIL "Missing support for thread-safe SSL") ) 54 | 55 | (unless (= *NE_OK (ne-sock-init)) 56 | (throw-error NIL "Could not initiate socket") ) 57 | 58 | (seed (in "/dev/urandom" (rd 20))) 59 | 60 | 61 | # public 62 | (de uriparse (Url) 63 | (parse-uri Url) ) 64 | 65 | (de req-get (Url Headers Filename) 66 | (req "GET" Url Headers Filename) ) 67 | 68 | (de req-head (Url Headers) 69 | (req "HEAD" Url Headers) ) 70 | 71 | (de req-post (Url Headers Filename Body) 72 | (req "POST" Url Headers Filename Body) ) 73 | 74 | (de req-put (Url Headers Filename Body) 75 | (req "PUT" Url Headers Filename Body) ) 76 | 77 | (de req-delete (Url Headers Filename) 78 | (req "DELETE" Url Headers Filename) ) 79 | 80 | [de req (Method Url Headers Filename Body) 81 | (let ((Session Path Request) (create-session-request Method Url Headers)) 82 | (let Buffer (set-request-body Request Body) 83 | (finally 84 | (end-request-session Request Session Buffer) 85 | (let Output (request-dispatch Request Session) 86 | (parse-response Request Url Output) ] 87 | -------------------------------------------------------------------------------- /test/test_https.l: -------------------------------------------------------------------------------- 1 | (setq 2 | *My_tests_are_order_dependent NIL 3 | *Https_output (req-get "https://google.com/404" NIL T) 4 | *Donate_page (req-get "http://software-lab.de/donate.html" NIL NIL) 5 | *404_page (req-head "https://google.com/404") ) 6 | 7 | [de test-uriparse-success () 8 | (unit~assert-equal '("http" "test.url" "user:pass" 443 "/test/file.txt" "question=answer" "section") 9 | (uriparse "http://user:pass@test.url:443/test/file.txt?question=answer#section") 10 | "Successfully parse a valid URI" ] 11 | 12 | [de test-uriparse-fail () 13 | (unit~assert-throws 'InternalError 14 | '(HttpsError . "Unable to parse URI") 15 | '(uriparse "http://test.url/test/[test]") 16 | "Fail to parse an invalid URI" ] 17 | 18 | [de test-get-404 () 19 | (unit~assert-includes '("Code" . 404) 20 | *Https_output 21 | "Returns a 404 error page from HTTPS request" ] 22 | 23 | [de test-get-tempfile () 24 | (unit~assert-includes '("Filename") 25 | *Https_output 26 | "Downloads the body into a temporary filename" ] 27 | 28 | [de test-get-headers () 29 | (unit~assert-kind-of 'List 30 | (cdr (assoc "Headers" *Https_output)) 31 | "Returns a list of HTTP Headers" ] 32 | 33 | [de test-get-body () 34 | (unit~assert-includes '("Body") 35 | *Donate_page 36 | "Returns the body as a result (not a file) from HTTP request" ] 37 | 38 | [de test-get-url () 39 | (unit~assert-equal '("Url" . "http://software-lab.de/donate.html") 40 | (assoc "Url" *Donate_page) 41 | "Returns the URL of the donate page 'http://software-lab.de/donate.html' for PicoLisp" ] 42 | 43 | [de test-head-nobody () 44 | (unit~assert-nil (cdr (assoc "Body" *404_page)) 45 | "HEAD requests don't return a body" ] 46 | 47 | [de test-head () 48 | (unit~assert-includes '("Code" . 404) 49 | *404_page 50 | "HEAD requests work" ] 51 | 52 | [de test-post () 53 | (unit~assert-includes '("Body") 54 | (req-post 55 | "http://requestb.in/10l0pw01" 56 | '(("Content-Type" . "application/json")) 57 | NIL 58 | "{\"Hello\":\"World\"}" ) 59 | "POST requests work" ] 60 | 61 | [unit~execute 62 | '(test-uriparse-success) 63 | '(test-uriparse-fail) 64 | '(test-get-404) 65 | '(test-get-tempfile) 66 | '(test-get-headers) 67 | '(test-get-body) 68 | '(test-get-url) 69 | '(test-head-nobody) 70 | '(test-head) 71 | '(test-post) ] 72 | -------------------------------------------------------------------------------- /ffi.l: -------------------------------------------------------------------------------- 1 | # ffi.l 2 | # 3 | # The MIT License (MIT) 4 | # 5 | # Copyright (c) 2015 Alexander Williams, Unscramble 6 | 7 | (de ne-sock-init () 8 | (native `*Https "ne_sock_init" 'I) ) 9 | 10 | (de ne-version-string () 11 | (native `*Https "ne_version_string" 'S) ) 12 | 13 | (de ne-has-support (Feature) 14 | (native `*Https "ne_has_support" 'I Feature) ) 15 | 16 | (de ne-get-error (Session) 17 | (native `*Https "ne_get_error" 'S Session) ) 18 | 19 | # returns the result in 'car', parsed URI in 'cdr' 20 | [de ne-uri-parse (Uri &ne_uri) 21 | (use Parsed 22 | (cons 23 | (native `*Https "ne_uri_parse" 'I Uri (list 'Parsed &ne_uri)) 24 | Parsed ] 25 | 26 | (de ne-uri-defaultport (Scheme) 27 | (native `*Https "ne_uri_defaultport" 'I Scheme) ) 28 | 29 | (de ne-add-request-header (Request Name Value) 30 | (native `*Https "ne_add_request_header" NIL Request Name Value) ) 31 | 32 | (de ne-session-create (Scheme Hostname Port) 33 | (native `*Https "ne_session_create" 'N Scheme Hostname Port) ) 34 | 35 | (de ne-ssl-trust-default-ca (Session) 36 | (native `*Https "ne_ssl_trust_default_ca" NIL Session) ) 37 | 38 | (de ne-request-create (Session Method Path) 39 | (native `*Https "ne_request_create" 'N Session Method Path) ) 40 | 41 | (de ne-begin-request (Request) 42 | (native `*Https "ne_begin_request" 'I Request) ) 43 | 44 | (de ne-end-request (Request) 45 | (native `*Https "ne_end_request" 'I Request) ) 46 | 47 | # returns the result in 'car', value of &buffer in 'cdr' 48 | (de ne-read-response-block (Request &buffer Length) 49 | (use Buf 50 | (cons 51 | (native `*Https "ne_read_response_block" 'I 52 | Request 53 | (cons 'Buf &buffer 0) 54 | Length ) 55 | Buf ] 56 | 57 | (de ne-read-response-to-fd (Request Fd) 58 | (native `*Https "ne_read_response_to_fd" 'I Request Fd) ) 59 | 60 | (de ne-set-request-body-buffer (Request Buffer Size) 61 | (native `*Https "ne_set_request_body_buffer" NIL Request Buffer Size) ) 62 | 63 | (de ne-request-destroy (Request) 64 | (native `*Https "ne_request_destroy" NIL Request) ) 65 | 66 | (de ne-close-connection (Session) 67 | (native `*Https "ne_close_connection" NIL Session) ) 68 | 69 | (de ne-session-destroy (Session) 70 | (native `*Https "ne_session_destroy" NIL Session) ) 71 | 72 | (de ne-get-status (Request) 73 | (native `*Https "ne_get_status" 'N Request) ) 74 | 75 | [de ne-response-header-iterate (Request Cursor &name &value) 76 | (use (Name Value) 77 | (list 78 | (native `*Https "ne_response_header_iterate" 'N 79 | Request 80 | Cursor 81 | (cons 'Name &name 0) 82 | (cons 'Value &value 0) ) 83 | Name 84 | Value ] 85 | 86 | (de ne-set-server-auth (Session Creds_cb Userdata) 87 | (native `*Https "ne_set_server_auth" NIL Session Creds_cb Userdata) ) 88 | 89 | (de ne-forget-auth (Session) 90 | (native `*Https "ne_forget_auth" NIL Session) ) 91 | -------------------------------------------------------------------------------- /internal.l: -------------------------------------------------------------------------------- 1 | # internal.l 2 | # 3 | # The MIT License (MIT) 4 | # 5 | # Copyright (c) 2015 Alexander Williams, Unscramble 6 | 7 | [de throw-error (Session Message) 8 | (throw 'InternalError (cons 'HttpsError (if Session 9 | (ne-get-error Session) 10 | Message ] 11 | 12 | [de create-session-request (Method Url Headers) 13 | (let ((Session . Path) (create-session Url) 14 | Request (ne-request-create Session Method Path) ) 15 | 16 | (set-headers Headers Request) 17 | (list Session Path Request) ] 18 | 19 | [de create-session (Fullurl) 20 | (let (Uri (parse-uri Fullurl) 21 | Scheme (car Uri) 22 | Host (cadr Uri) 23 | Auth (; Uri 3) 24 | Port (get-port Scheme (; Uri 4)) 25 | Session (ne-session-create Scheme Host Port) 26 | Path (pack (; Uri 5) (when (; Uri 6) (pack "?" (; Uri 6)))) ) 27 | 28 | (set-auth-credentials Session Auth) 29 | 30 | (when (= Scheme "https") (ne-ssl-trust-default-ca Session)) 31 | 32 | (cons Session Path) ] 33 | 34 | [de parse-uri (Fullurl) 35 | (let Result 36 | (ne-uri-parse Fullurl '(56 (S S S N S S S))) # *ne_uri URI structure (56 Bytes) 37 | (if (=0 (car Result)) 38 | (cadr Result) 39 | (throw-error NIL "Unable to parse URI") ] 40 | 41 | [de get-port (Scheme Port) 42 | (if (> Port 0) 43 | Port 44 | (ne-uri-defaultport Scheme) ] 45 | 46 | [de set-auth-credentials (Session Auth) 47 | [let Credentials (split (chop Auth) ":") 48 | (setq *User (pack (car Credentials)) 49 | *Pass (pack (cdr Credentials)) ] 50 | 51 | (ne-set-server-auth 52 | Session 53 | (lisp 'ne_auth_creds '((A B C D E) (do-auth A B C D E))) 54 | 0 ] 55 | 56 | (de do-auth (Userdata Realm Attempt Username Password) 57 | (native "@" "strncpy" NIL Username *User *NE_ABUFSIZ) 58 | (native "@" "strncpy" NIL Password *Pass *NE_ABUFSIZ) 59 | Attempt ) 60 | 61 | [de del-auth-credentials (Session) 62 | (ne-forget-auth Session) 63 | (off *User) 64 | (off *Pass) ] 65 | 66 | [de set-headers (Headers Request) 67 | (mapcar 68 | '((L) (ne-add-request-header Request (car L) (cdr L))) 69 | (append Headers *Headers) ] 70 | 71 | [de set-request-body (Request Body) 72 | (when Body 73 | (let (Size (size Body) 74 | Buf (native "@" "malloc" 'N Size) ) 75 | 76 | (native "@" "memset" NIL Buf Body Size) 77 | (let Buffer (native "@" "strncpy" 'N Buf Body Size) 78 | (ne-set-request-body-buffer Request Buffer Size) 79 | Buf ] 80 | 81 | [de request-dispatch (Request Session) 82 | (use Body 83 | (loop 84 | (begin-request) 85 | 86 | (setq Body (if Filename 87 | (download-file Request Filename) 88 | (process-body Request) ) ) 89 | 90 | (T (end-request) 'done) ) 91 | Body ] 92 | 93 | [de download-file (Request Filename) 94 | (let File (if (=T Filename) 95 | (random-filename) 96 | Filename ) 97 | 98 | (let Fd (open File) 99 | (unless Fd (throw-error NIL (pack "Unable to write to file: " File))) 100 | (ne-read-response-to-fd Request Fd) 101 | (close Fd) 102 | (list (cons "Filename" File) 103 | (cons "Filesize" (car (info File))) ] 104 | 105 | (de random-filename () 106 | (tmp "dl-" (random-id) "-" (inc (0)) ".tmp") ) 107 | 108 | [de random-id () 109 | (lowc (hex (abs (rand) ] 110 | 111 | [de process-body (Request) 112 | (let Body 113 | [make 114 | (while 115 | (> (car (link-response-block Request)) 116 | 0 ] 117 | 118 | (cons "Body" (pack Body)) ] 119 | 120 | [de link-response-block (Request) 121 | (let Result (ne-read-response-block Request '(`*Buffer_size B . `*Buffer_size) *Buffer_size) 122 | (link (pack-body Result)) ] 123 | 124 | [de pack-body (Result) 125 | (pack (mapcar char (head (car Result) (cdr Result) ] 126 | 127 | [de parse-response (Request Fullurl Output) 128 | (let (Headers (make (get-headers Request 0)) 129 | Status (struct (ne-get-status Request) '(I I I I S)) # *ne_status Status structure 130 | Version (pack "HTTP/" (car Status) "." (cadr Status)) 131 | Code (; Status 3) 132 | Message (; Status 5) ) 133 | 134 | (list Output 135 | (cons "Version" . Version) 136 | (cons "Code" . Code) 137 | (cons "Message" . Message) 138 | (cons "Url" . Fullurl) 139 | (cons "Headers" Headers) ] 140 | 141 | [de get-headers (Request Cursor) 142 | (let ((Recursor Name Value) (ne-response-header-iterate Request Cursor '(N S) '(N S))) 143 | (when (> Recursor 0) 144 | (link (cons (car Name) (car Value))) 145 | (get-headers Request Recursor) ] 146 | 147 | (de end-request-session (Request Session Buffer) 148 | (when Buffer (native "@" "free" NIL Buffer)) 149 | (ne-request-destroy Request) 150 | (del-auth-credentials Session) 151 | (end-session Session) ) 152 | 153 | (de end-session (Session) 154 | (ne-close-connection Session) 155 | (ne-session-destroy Session) ) 156 | 157 | # Request and Session rely on their context (dynamic scope) 158 | # in case of bugs, look here first ;) 159 | [de begin-request () 160 | (unless (= *NE_OK (ne-begin-request Request)) 161 | (throw-error Session) ] 162 | 163 | [de end-request () 164 | (let Result (ne-end-request Request) 165 | (cond ((= *NE_RETRY Result) (wait 1000) NIL) 166 | ((unless (= *NE_OK Result) 167 | (throw-error Session) ) ) 168 | (T T) ] 169 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # WARNING: DEPRECATED 2 | 3 | I don't use this anymore, and don't plan on maintaining it. Please use at your own risk. 4 | 5 | # HTTP(S) client for PicoLisp 6 | 7 | [![GitHub release](https://img.shields.io/github/release/aw/picolisp-https.svg)](https://github.com/aw/picolisp-https) [![Build Status](https://travis-ci.org/aw/picolisp-https.svg?branch=master)](https://travis-ci.org/aw/picolisp-https) [![Dependency](https://img.shields.io/badge/[deps] Neon-0.30.1-ff69b4.svg)](https://github.com/aw/neon-unofficial-mirror) [![Dependency](https://img.shields.io/badge/[deps] picolisp--unit-v1.0.0-ff69b4.svg)](https://github.com/aw/picolisp-unit.git) 8 | 9 | This library can be used to make HTTP and HTTPS requests in [PicoLisp](http://picolisp.com), with support for authentication. 10 | 11 | ![picolisp-https](https://cloud.githubusercontent.com/assets/153401/6665239/08fe38ee-cbcf-11e4-8289-603c985c1c0f.png) 12 | 13 | Please read [EXPLAIN.md](EXPLAIN.md) to learn more about PicoLisp and this HTTPS library. 14 | 15 | 1. [Requirements](#requirements) 16 | 2. [Getting Started](#getting-started) 17 | 3. [Usage](#usage) 18 | 4. [Examples](#examples) 19 | 5. [Testing](#testing) 20 | 6. [Alternatives](#alternatives) 21 | 7. [Contributing](#contributing) 22 | 8. [License](#license) 23 | 24 | # Requirements 25 | 26 | * PicoLisp 64-bit v3.1.9+ 27 | * Tested up to PicoLisp v16.12 28 | * Git 29 | * UNIX/Linux development/build tools (gcc, make/gmake, etc..) 30 | * OpenSSL 31 | 32 | # Getting Started 33 | 34 | These FFI bindings require the [Neon C library](http://www.webdav.org/neon/), compiled as a shared library. 35 | 36 | 1. Type `make` to pull and compile the _Neon C Library_. 37 | 2. Include `https.l` in your project (it loads `ffi.l` and `internal.l`). 38 | 3. Try the [examples](#examples) below 39 | 40 | ### Linking and Paths 41 | 42 | Once compiled, the shared library is symlinked as: 43 | 44 | .lib/libneon.so -> .modules/neon/HEAD/src/.libs/libneon.so 45 | 46 | The `https.l` file searches for `.lib/libneon.so`, relative to its current directory. 47 | 48 | ### Updating 49 | 50 | To keep everything updated, type: 51 | 52 | git pull && make clean && make 53 | 54 | # Usage 55 | 56 | Only the following functions are exported publicly, and namespaced with `(symbols 'https)` (or the prefix: `https~`): 57 | 58 | * **(uriparse Url)** parses a sanitized URL into its separate parts 59 | - `Url` _String_: a URL string to be parsed (does not encode the URL) 60 | * **(req-get Url Headers Filename)** performs an HTTP `GET` request 61 | - `Url` _String_: a URL string to make the HTTP request 62 | - `Headers` _List (optional)_: a PicoLisp list of cons pairs containing HTTP headers 63 | - `Filename` _String_ or _Flag (optional)_: can be a full path to a filename to store the HTTP Body content, the flag `T` to generate a random filename and store in a tmp dir (`~/.pil/tmp`), or `NIL` to return the Body in the `Response` list 64 | * **(req-head Url Headers)** performs an HTTP `HEAD` request 65 | - `Url` _String_: a URL string to make the HTTP request 66 | - `Headers` _List (optional)_: a PicoLisp list of cons pairs containing HTTP headers 67 | * **(req-post Url Headers Filename Body)** performs an HTTP `POST` request 68 | - `Url` _String_: a URL string to make the HTTP request 69 | - `Headers` _List (optional)_: a PicoLisp list of cons pairs containing HTTP headers 70 | - `Filename` _String_ or _Flag (optional)_: can be a full path to a filename to store the HTTP Body content, the flag `T` to generate a random filename and store in a tmp dir (`~/.pil/tmp`), or `NIL` to return the Body in the `Response` list 71 | - `Body` _String (optional)_: a string to be sent as part of the HTTP body. Make sure to set the proper `Content-Type` headers. 72 | * **(req-put Url Headers Filename Body)**: performs an idempotent HTTP `PUT` request (same as `POST`). 73 | * **(req-delete Url Headers Filename)**: performs an HTTP `DELETE` request 74 | - `Url` _String_: a URL string to make the HTTP request 75 | - `Headers` _List (optional)_: a PicoLisp list of cons pairs containing HTTP headers 76 | - `Filename` _String_ or _Flag (optional)_: can be a full path to a filename to store the HTTP Body content, the flag `T` to generate a random filename and store in a tmp dir (`~/.pil/tmp`), or `NIL` to return the Body in the `Response` list 77 | * **(req Method Url Headers Filename Body)**: performs an HTTP requeste using the `Method` you provide. The arguments to `req` are the same as the convenience methods list above. 78 | 79 | > **Note:** These functions are not namespace [local symbols](http://software-lab.de/doc/refL.html#local), which means they would redefine symbols with the same name in the `'pico` namespace 80 | 81 | ### Notes 82 | 83 | * A successful result will return a list. Failures return `NIL` or throw an `'InternalError`. 84 | * Arguments are not sanitized, validated, encoded or cleaned in any way. It's up to you to perform those tasks before sending data to the public functions. 85 | * Only three default headers are sent on each request. They can be overwritten to suit your needs: 86 | - `Accept: */*` 87 | - `Accept-Charset: utf/8` 88 | - `User-Agent: picolisp-https` 89 | * The `Host` header and `HTTP/1.1` strings are sent automatically by the native C library. 90 | - Many authorization schemes are supported, but only `Auth-Basic and Auth-Digest` have been tested successfully. See [more here](https://github.com/aw/neon-unofficial-mirror/blob/master/src/ne_auth.h#L67). 91 | 92 | # Examples 93 | 94 | ### (uriparse Url) 95 | 96 | ```lisp 97 | pil + 98 | 99 | (load "https.l") 100 | 101 | (symbols 'https) 102 | (uriparse "http://user:pass@test.url:443/test/file.txt?question=answer#section") 103 | 104 | -> ("http" "test.url" "user:pass" 443 "/test/file.txt" "question=answer" "section") 105 | ``` 106 | 107 | ### Error: (req-get Url Headers Filename) 108 | 109 | Mistakes happen, and we've added a facility to catch errors when they do occur. Simply `(catch 'InternalError` and do what you want with it. 110 | 111 | ```lisp 112 | pil + 113 | 114 | (load "https.l") 115 | 116 | (symbols 'https) 117 | (println 118 | (catch 'InternalError 119 | (req-get "https://test.url" NIL NIL) ) ) 120 | 121 | -> (HttpsError . "Could not resolve hostname `test.url': Host not found") 122 | ``` 123 | 124 | ### (req-get Url Headers Filename) 125 | 126 | In this example, we try to fetch from a URL that doesn't exist, and receive a response body stored in a temporary file, status code, headers, and other useful information. 127 | 128 | ```lisp 129 | pil + 130 | 131 | (load "https.l") 132 | 133 | (symbols 'https) 134 | (pretty 135 | (req-get 136 | "https://google.com/404" 137 | '(("Referer" . "http://test.url") ("User-Agent" . "picolisp-https-example")) 138 | T ) ) 139 | 140 | -> ((("Filename" . "/home/aw/.pil/tmp/2363/dl-7d702f36-1.tmp") ("Filesize" . 1428)) 141 | ("Version" . "HTTP/1.1") 142 | ("Code" . 404) 143 | ("Message" . "Not Found") 144 | ("Url" . "https://google.com/404") 145 | ("Headers" ("date" . "Mon, 16 Mar 2015 10:50:07 GMT") ("content-length" . "1428") ("server" . "GFE/2.0") ("content-type" . "text/html; charset=UTF-8")) ) 146 | ``` 147 | 148 | ### (req-get Url Headers NIL) 149 | 150 | Here we try to fetch from a URL which does exist, and receive the response body output. 151 | 152 | ```lisp 153 | pil + 154 | 155 | (load "https.l") 156 | 157 | (symbols 'https) 158 | (pretty 159 | (req-get "http://software-lab.de/donate.html" NIL) ) 160 | 161 | -> (("Body" . "^J^J 162 | ^J^JDonate to PicoLisp^J^J^J^J^J
^J

Donate to Pico 164 | Lisp

^J^J If you want to support the development and maintenance of PicoLisp,
^J you can donate Bitcoins to the ad 165 | dress
^J
^J 18hPeB7sEtwMvRVrBMmwhJ3hkFzFda2QHN
^J
^J Please send a note to
^J btc<at>software-lab.de
^J if you like your name to be mentioned.
^J
^J Thank you for your support!^J
^J^J
^J 167 |

Thanks to all Donors:

^J Jon Kleiser
^J Heow Goodman
^J
^J^J^J^J") 168 | ("Version" . "HTTP/1.1") 169 | ("Code" . 200) 170 | ("Message" . "OK") 171 | ("Url" . "http://software-lab.de/donate.html") 172 | ("Headers" 173 | ("last-modified" . "Thu, 30 Oct 2014 12:25:01 GMT") 174 | ("date" . "Mon, 16 Mar 2015 10:56:37 GMT") 175 | ("keep-alive" . "timeout=3, max=100") 176 | ("content-length" . "1016") 177 | ("connection" . "Keep-Alive") 178 | ("accept-ranges" . "bytes") 179 | ("etag" . "\"757d8-3f8-506a2f824b149\"") 180 | ("server" . "Apache/2.2.29 (Unix)") 181 | ("content-type" . "text/html") ) ) 182 | ``` 183 | 184 | ### (req-head Url Headers) 185 | 186 | An HTTP `HEAD` request never returns a body. You can see it in the result, the `Body` item has no `cdr`. 187 | 188 | ```lisp 189 | pil + 190 | 191 | (load "https.l") 192 | 193 | (symbols 'https) 194 | (pretty (req-head "http://software-lab.de/COPYING" NIL)) 195 | 196 | -> (("Body") 197 | ("Version" . "HTTP/1.1") 198 | ("Code" . 200) 199 | ("Message" . "OK") 200 | ("Url" . "http://software-lab.de/COPYING") 201 | ("Headers" 202 | ("last-modified" . "Mon, 16 Mar 2015 08:40:12 GMT") 203 | ("date" . "Mon, 16 Mar 2015 10:57:57 GMT") 204 | ("keep-alive" . "timeout=3, max=100") 205 | ("content-length" . "1078") 206 | ("connection" . "Keep-Alive") 207 | ("accept-ranges" . "bytes") 208 | ("etag" . "\"4ba06-436-51163cc69f4fd\"") 209 | ("server" . "Apache/2.2.29 (Unix)") 210 | ("content-type" . "text/plain") ) ) 211 | ``` 212 | 213 | ### (req-post Url Headers Filename Body) 214 | 215 | Here we send an HTTP `POST` request with a JSON string (body), and receive the `ok` response body, along with some headers. 216 | 217 | ```lisp 218 | pil + 219 | 220 | (load "https.l") 221 | 222 | (symbols 'https) 223 | (pretty 224 | (req-post 225 | "http://requestb.in/10l0pw01" 226 | '(("Content-Type" . "application/json")) 227 | NIL 228 | "{\"Hello\":\"World\"}" ) ) 229 | 230 | -> (("Body" . "ok") 231 | ("Version" . "HTTP/1.1") 232 | ("Code" . 200) 233 | ("Message" . "OK") 234 | ("Url" . "http://requestb.in/10l0pw01") 235 | ("Headers" 236 | ("via" . "1.1 vegur") 237 | ("date" . "Mon, 16 Mar 2015 11:04:05 GMT") 238 | ("content-length" . "2") 239 | ("connection" . "keep-alive") 240 | ("server" . "gunicorn/18.0") 241 | ("sponsored-by" . "https://www.runscope.com") 242 | ("content-type" . "text/html; charset=utf-8") ) ) 243 | ``` 244 | 245 | ### (req-put) / (req-delete) 246 | 247 | Pretty much the same as above. 248 | 249 | ### (req Method Url Headers Filename Body) 250 | 251 | In this example, we send a request with a custom HTTP method. 252 | 253 | ```lisp 254 | pil + 255 | 256 | (load "https.l") 257 | 258 | (symbols 'https) 259 | (pretty (req "PICO" "https://encrypted.google.com/search?hl=en&q=recursion")) 260 | 261 | -> (("Body" . "^J^J ^J ^J Error 405 (Method Not Allowed)!!1^J ^J ^J

405. Thatâs an error.^J

The request method PICO is inappropriate for the URL /search. Thatâs all we know.^J") 271 | ("Version" . "HTTP/1.1") 272 | ("Code" . 405) 273 | ("Message" . "Method Not Allowed") 274 | ("Url" . "https://encrypted.google.com/search?hl=en&q=recursion") 275 | ("Headers" ("date" . "Mon, 16 Mar 2015 11:09:29 GMT") ("content-length" . "1459") ("alternate-protocol" . "443:quic,p=0.5") ("server" . "GFE/2.0") ("content-type 276 | " . "text/html; charset=UTF-8")) ) 277 | ``` 278 | 279 | # Testing 280 | 281 | This library now comes with full [unit tests](https://github.com/aw/picolisp-unit). To run the tests, type: 282 | 283 | make check 284 | 285 | # Alternatives 286 | 287 | The following are alternatives written in pure PicoLisp. They are limited by pipe/read syscalls and shell exec commands. 288 | 289 | * [HTTP request](http://rosettacode.org/wiki/HTTP#PicoLisp) on Rosetta Code. 290 | * [HTTPS request](http://rosettacode.org/wiki/HTTPS#PicoLisp) on Rosetta Code. 291 | 292 | # Contributing 293 | 294 | If you find any bugs or issues, please [create an issue](https://github.com/aw/picolisp-https/issues/new). 295 | 296 | If you want to improve this library, please make a pull-request. 297 | 298 | # License 299 | 300 | [MIT License](LICENSE) 301 | 302 | Copyright (c) 2015 Alexander Williams, Unscramble 303 | -------------------------------------------------------------------------------- /EXPLAIN.md: -------------------------------------------------------------------------------- 1 | # Explanation: HTTP(S) client for PicoLisp 2 | 3 | This document provides a short walkthrough of the source code for the [PicoLisp-HTTPS](https://github.com/aw/picolisp-https.git) client. 4 | 5 | I won't cover concepts which were covered in previous source code explanations. You can read them here: 6 | 7 | * [Nanomsg Explanation](https://github.com/aw/picolisp-nanomsg/blob/master/EXPLAIN.md) 8 | * [JSON Explanation](https://github.com/aw/picolisp-json/blob/master/EXPLAIN.md) 9 | 10 | This document is split into a few sections: 11 | 12 | 1. [Loading and initialization](#loading-and-initialization): Loading files and performing initial work. 13 | 2. [Error handling](#error-handling): An idiom for handling errors. 14 | 3. [Internal functions](#internal-functions): Destructuring, native C callbacks, and memory management. 15 | * [making HTTPS requests](#making-https-requests) 16 | * [parsing HTTPS responses](#parsing-https-responses) 17 | * [cleaning up errors](#cleaning-up-errors) 18 | 19 | Make sure you read the [README](README.md) to get an idea of what this library does. 20 | 21 | # Loading and initialization 22 | 23 | We've made some changes to how we load files across all libraries. 24 | 25 | ### Loading 26 | 27 | [PicoLisp](http://picolisp.com) loads files from the _current working directory_ [pwd](http://software-lab.de/doc/refP.html#pwd), which is in relation to where you ran the command: 28 | 29 | ```lisp 30 | alex@dev-box:~/picolisp-https$ pil + 31 | : (pwd) 32 | -> "/home/aw/picolisp-https" 33 | ``` 34 | 35 | So far so good, but what happens when the file you load also loads a file in a different directory? Depending if the path is relative or absolute, you will not necessarily get what you want. 36 | 37 | To fix this, we use [file](http://software-lab.de/doc/refF.html#file): 38 | 39 | ```lisp 40 | *Https (pack (car (file)) ".lib/libneon.so") 41 | ``` 42 | 43 | What this does is load the file `.lib/libneon.so` relative to the file that's loading it. 44 | 45 | We use this technique further down as well: 46 | 47 | ```lisp 48 | # ffi-bindings 49 | (load (pack (car (file)) "ffi.l")) 50 | 51 | # internal 52 | (load (pack (car (file)) "internal.l")) 53 | ``` 54 | 55 | Perhaps there should be a `(cwd)` primitive for that? ;) 56 | 57 | ### Initialization 58 | 59 | There is a concept of `constructors` in PicoLisp, but it's only used with classes and objects. We're trying to be functional here. 60 | 61 | Our approach is simple: perform initialization tasks after loading all the necessary files. 62 | 63 | ```lisp 64 | (when (=0 (ne-has-support *NE_FEATURE_SSL)) 65 | (throw-error NIL "Missing support for SSL/TLS") ) 66 | ``` 67 | 68 | What we've done here is try to ensure `SSL` is compiled into the shared library. If it's not, an error is thrown. [Error handling](#error-handling) is explained in the next section. 69 | 70 | We also ensure to [seed](http://software-lab.de/doc/refS.html#seed) some random data from the system's random pool: 71 | 72 | ```lisp 73 | (seed (in "/dev/urandom" (rd 20))) 74 | ``` 75 | 76 | This tries to obtain `20 bytes` from `/dev/urandom` using [rd](http://software-lab.de/doc/refR.html#rd), a function for reading raw bytes from an input stream, and initializes the seed with it. 77 | 78 | # Error handling 79 | 80 | PicoLisp provides us with a few ways to handle errors, so why not use them to our advantage? 81 | 82 | My idea was: 83 | 84 | 1. Throw errors in the library, but don't quit/exit disgracefully (a.k.a. be nice). 85 | 2. Provide a _type_ of error, and a brief message explaining what happened. 86 | 3. Allow the user to catch the errors outside the library. 87 | 88 | ```lisp 89 | [de throw-error (Session Message) 90 | (throw 'InternalError (cons 'HttpsError (if Session 91 | (ne-get-error Session) 92 | Message ] 93 | ``` 94 | 95 | The **Neon C library** has a function `(ne-get-error)` which returns a string containing an error message (if any). Sometimes, we want to provide our own error message though. 96 | 97 | In the `(throw-error)` function, we satisfy the first two requirements by using [throw](http://software-lab.de/doc/refT.html#throw) to send an `'InternalError`, along with a [cons](http://software-lab.de/doc/refC.html#cons) pair containing the `'HttpsError` _type_ in the [car](http://software-lab.de/doc/refC.html#car) and the error _message_ in the [cdr](http://software-lab.de/doc/refC.html#cdr). 98 | 99 | The third requirement is satisfied in user applications with something like this: 100 | 101 | ```lisp 102 | (println (catch 'InternalError 103 | .. ) ) 104 | 105 | -> (HttpsError . "Could not connect to server: Connection timed out") 106 | ``` 107 | 108 | # Internal functions 109 | 110 | As usual, the bulk of the library occurs in the internal functions. 111 | 112 | ## making HTTPS requests 113 | 114 | PicoLisp 64-bit got a new feature in 2015: `destructuring 'let'`. 115 | 116 | If you're coming from other languages such as Ruby, you would destructure an array like this: 117 | 118 | ```ruby 119 | var1, var2 = ["one", "two"] 120 | ``` 121 | 122 | In PicoLisp, we use this to obtain a Session (pointer) and Path (string), which is a cons pair returned by the `(create-session)` function. 123 | 124 | ```lisp 125 | [de create-session-request (Method Url Headers) 126 | (let ((Session . Path) (create-session Url) 127 | Request (ne-request-create Session Method Path) ) 128 | 129 | (set-headers Headers Request) 130 | (list Session Path Request) ] 131 | ``` 132 | 133 | ### (create-session) 134 | 135 | In `(create-session)`, we parse the Url and obtain all the separate components, which are returned to us in a simple list. We're already familiar with `(car)`, `(cdr)`, `(cddr)`, etc, but there's another primitive to get the exact item in a list: it's the dreaded [semicolon (;)](http://software-lab.de/doc/ref_.html#;) _(insert JavaScript joke here)_ 136 | 137 | ```lisp 138 | [de create-session (Fullurl) 139 | (let (Uri (parse-uri Fullurl) 140 | Scheme (car Uri) 141 | Host (cadr Uri) 142 | Auth (; Uri 3) 143 | Port (get-port Scheme (; Uri 4)) 144 | Session (ne-session-create Scheme Host Port) 145 | Path (pack (; Uri 5) (when (; Uri 6) (pack "?" (; Uri 6)))) ) 146 | .. 147 | ``` 148 | 149 | Notice we use `(; Uri 3)`. This is cool, it'll get the item in the 3rd position in the list. In this case, it's the auth credentials (usually user:password). 150 | 151 | The semicolon has other uses as well, so make sure you read about it. 152 | 153 | ### (set-auth-credentials) 154 | 155 | This function does two things, one is dangerous, the other is cool. 156 | 157 | ```lisp 158 | [de set-auth-credentials (Session Auth) 159 | [let Credentials (split (chop Auth) ":") 160 | (setq *User (pack (car Credentials)) 161 | *Pass (pack (cdr Credentials)) ] 162 | 163 | (ne-set-server-auth 164 | Session 165 | (lisp 'ne_auth_creds '((A B C D E) (do-auth A B C D E))) 166 | 0 ] 167 | ``` 168 | 169 | Let's talk about danger first. In this function, we uses [setq](http://software-lab.de/doc/refS.html#setq) to create some _temporary_ global variables. I say temporary because we get rid of them later. The danger here is this is **NOT functional**. It's a side-effect which could be the source of bugs in the future. OOP lovers don't care about this kind of stuff, but in FP land it's a big no-no. 170 | 171 | > **Note:** The reason we do this is because of the `(do-auth)` function, which we'll explain later. 172 | 173 | The [lisp](http://software-lab.de/doc/refL.html#lisp) function is quite special. When using `(native)` for C calls, certain functions require a callback as an argument, or "function pointer" (Google it). 174 | 175 | The `(ne-set-server-auth)` function requires a callback as its second argument, so we create one using `(lisp)`. If you've read the [JSON explanations](https://github.com/aw/picolisp-json/blob/master/EXPLAIN.md#make-array), you'll quickly notice there's an anonymous function in this `(lisp)` call. It essentially sends 5 arguments (which are numbers) to the `(do-auth)` function, under the name `ne_auth_creds`. 176 | 177 | Here's the C code to give a better picture: 178 | 179 | ```C 180 | typedef int (*ne_auth_creds)(void *userdata, const char *realm, int attempt, 181 | char *username, char *password); 182 | 183 | void ne_set_server_auth(ne_session *sess, ne_auth_creds creds, void *userdata); 184 | ``` 185 | 186 | See that? All arguments for `ne_auth_creds` are numbers (void, pointers, int).. 187 | 188 | ### (do-auth) 189 | 190 | This function is our actual callback function. It's the one that will be called from the C library. 191 | 192 | The main requirement is to set the `username`, `password`, and return an integer. We do that here: 193 | 194 | ```lisp 195 | (de do-auth (Userdata Realm Attempt Username Password) 196 | (native "@" "strncpy" NIL Username *User *NE_ABUFSIZ) 197 | (native "@" "strncpy" NIL Password *Pass *NE_ABUFSIZ) 198 | Attempt ) 199 | ``` 200 | 201 | Whoa wait, what's that `@` thing doing there? Remember we talked about the [@ result](https://github.com/aw/picolisp-nanomsg/blob/master/EXPLAIN.md#nn_symbols)? Well, this is **NOT** that. 202 | 203 | This is actually a [transient symbol](http://software-lab.de/doc/native.html#libs) which refers to the main program (PicoLisp). 204 | 205 | > **Note:** In english, this means you can call standard C functions like `malloc` and `strcpy` (j/k, at least use strncpy). 206 | 207 | This function uses the `*User and *Pass` global variables we defined earlier and the C `strncpy()` functions to copy the global variables into the `Username` and `Password` _pointers_. The other approach would be to hardcode the username/password in the function, but really.. who does that? 208 | 209 | At the end of `(do-auth)`, we return the `Attempt` variable, which based on the **Neon** documentation, would only perform _one_ authentication attempt before failing. 210 | 211 | ### (del-auth-credentials) 212 | 213 | Of course, we need to remove the auth credentials once we're done with them. The `(ne-forget-auth)` function will remove them from memory, and [off](http://software-lab.de/doc/refO.html#off) will set the global variables to `NIL`. 214 | 215 | ```lisp 216 | [de del-auth-credentials (Session) 217 | (ne-forget-auth Session) 218 | (off *User) 219 | (off *Pass) ] 220 | ``` 221 | 222 | > **Note:** We could have also done: `(off *User *Pass)`. 223 | 224 | ### (set-headers) 225 | 226 | There's nothing magical in this function, just the usual mapping over a list with an **anonymous function**. 227 | 228 | ```lisp 229 | [de set-headers (Headers Request) 230 | (mapcar 231 | '((L) (ne-add-request-header Request (car L) (cdr L))) 232 | (append Headers *Headers) ] 233 | ``` 234 | 235 | I want to highlight [append](http://software-lab.de/doc/refA.html#append) which can be used to _append_ a list to another. Who would have known? 236 | 237 | The tricky thing is there's an order to it. We want the `Headers` variable to be used before the `*Headers` global variable. This way if you specify your own `User-Agent`, then it'll use that instead of the default. 238 | 239 | There were other ways to do this, but I just wanted to use `(append)`. 240 | 241 | ### (set-request-body) 242 | 243 | Now here's some more dangerous code if you haven't seen it yet. This function is used to set the request Body (ex: in a `POST` or `PUT` request) in a manually allocated buffer. 244 | 245 | The reason for this is due to an _interesting_ coding choice used in the **Neon** C library. It doesn't copy the body in memory for you, so at the end of a `(native)` call, the body (memory) is free'd and **Neon** can't use it anymore (because PicoLisp automatically frees memory). 246 | 247 | ```lisp 248 | [de set-request-body (Request Body) 249 | (when Body 250 | (let (Size (size Body) 251 | Buf (native "@" "malloc" 'N Size) ) 252 | 253 | (native "@" "memset" NIL Buf Body Size) 254 | (let Buffer (native "@" "strncpy" 'N Buf Body Size) 255 | (ne-set-request-body-buffer Request Buffer Size) 256 | Buf ] 257 | ``` 258 | 259 | We'll first obtain the [size](http://software-lab.de/doc/refS.html#size) of the request body. We do this for safety, and because it makes us feel warm inside. 260 | 261 | Since we're forced to manually allocate a buffer for the request body, you can see lots of funky C stuff in there. 262 | 263 | In the end though, we're able to send a perfectly good request body (`Buffer`) in our HTTP(S) request. 264 | 265 | Some sharp eyes may notice we don't `free` the allocated memory here. _evil laugh_. Don't worry, we've actually handled this elegantly, which you can read about in [cleaning up errors](#cleaning-up-errors). 266 | 267 | ## Parsing HTTPS responses 268 | 269 | Here we cover the function which dispatches a request, and then processes the response. 270 | 271 | ### (request-dispatch) 272 | 273 | The **Neon** C library provides a function to dispatch HTTP(S) requests, except for some odd reason it discards the response body before you can do anything with it. How horrible. 274 | 275 | ```lisp 276 | [de request-dispatch (Request Session) 277 | (use Body 278 | (loop 279 | (begin-request) 280 | 281 | (setq Body (if Filename 282 | (download-file Request Filename) 283 | (process-body Request) ) ) 284 | 285 | (T (end-request) 'done) ) 286 | Body ] 287 | ``` 288 | 289 | In this function, we've got an infinite [loop](http://software-lab.de/doc/refL.html#loop) which tries to make a request, save the **response body** to a file or whatever, and exits the loop when all is good. 290 | 291 | The `(end-request)` function implements a _retry_ mechanism, and returns either `T` or `NIL` (or throws an error). If the result is `T`, we execute `'done`, which is nothing really, and return the response body. Otherwise it loops. 292 | 293 | There's something _very_ different in this function though. Do you see it? 294 | 295 | The `Filename` variable is not sent as an argument to the function. So, how does it work? If you look at the [req](#req) function, you'll see the filename is (optionally) set as an argument. Our `(request-dispatch)` function uses the `Filename` variable from there. 296 | 297 | This is called `dynamic scoping`, one of the great advantages of PicoLisp. You can do stuff like that. 298 | 299 | > **Mr. Burger's Note:** As much as this is an advantage, it's also a sword hanging over your head. Use wisely. 300 | 301 | ### (download-file) 302 | 303 | This is a cool function. It checks if the `Filename` is set to `T`. If yes, then it generates a `(random-filename)`, otherwise it uses the filename provided. 304 | 305 | ```lisp 306 | [de download-file (Request Filename) 307 | (let File (if (=T Filename) 308 | (random-filename) 309 | Filename ) 310 | 311 | (let Fd (open File) 312 | (ne-read-response-to-fd Request Fd) 313 | (close Fd) 314 | (list (cons "Filename" . File) 315 | (cons "Filesize" (car (info File))) ] 316 | ``` 317 | 318 | We use [open](http://software-lab.de/doc/refO.html#open) and [close](http://software-lab.de/doc/refC.html#close) when working with files. The `(ne-read-response-to-fd)` function is designed to write the response body to a file descriptor. How convenient. 319 | 320 | Finally, we return a list with two cons pairs, one containing the Filename (potentially randomly generated) and the other containing the Filesize, which is captured using the [info](http://software-lab.de/doc/refI.html#info) function. 321 | 322 | ### random stuff 323 | 324 | Earlier, we looked at seeding random data, why? Well here's why: 325 | 326 | ```lisp 327 | (de random-filename () 328 | (tmp "dl-" (random-id) "-" (inc (0)) ".tmp") ) 329 | 330 | [de random-id () 331 | (lowc (hex (abs (rand) ] 332 | ``` 333 | 334 | The `(random-filename)` function generates a string that looks like this: `dl-7d702f36-1.tmp`. 335 | 336 | It uses [tmp](http://software-lab.de/doc/refT.html#tmp) to obtain the PicoLisp processes's temp directory, and the `(random-id)` function to generate a random id. 337 | 338 | Some cool functional stuff here: [lowc](http://software-lab.de/doc/refL.html#lowc) is used to lowercase a string, [hex](http://software-lab.de/doc/refH.html#hex) to generate a hexadecimal string, [abs](http://software-lab.de/doc/refA.html#abs) to return the absolute value of [rand](http://software-lab.de/doc/refR.html#rand) which returns a random integer (which should truly be random thanks to our [seed initialization](#initialization) from earlier). 339 | 340 | ### (process-body) 341 | 342 | This doesn't do anything we haven't seen before. It uses the familiar `(make)`, `(link)`, and `(pack)` to generate a list. 343 | 344 | In fact, the `(ne-read-response-block)` function is set to only read a specific `*Buffer_size` _(8192 bytes)_ of data at a time. We have a simple loop in `(process-body)` to obtain the full body and then pack it all together. 345 | 346 | ### (parse-response) 347 | 348 | Without going into too much detail for `(parse-response)`, I want to discuss something we haven't seen yet: [struct](http://software-lab.de/doc/refS.html#struct). 349 | 350 | ```lisp 351 | .. 352 | (struct (ne-get-status Request) '(I I I I S)) # *ne_status Status structure 353 | .. 354 | ``` 355 | 356 | The `(struct)` function can be used to _extract_ a C structure. The first argument is the structure, in our case it's the result of `(ne-get-status)`, and the structure contains 4 integers and 1 string. 357 | 358 | The C code for this: 359 | 360 | ```C 361 | typedef struct { 362 | int major_version; 363 | int minor_version; 364 | int code; /* Status-Code value */ 365 | int klass; /* Class of Status-Code (1-5) */ 366 | char *reason_phrase; 367 | } ne_status; 368 | ``` 369 | 370 | We return those in the response for each request. Actually we don't return `klass` because who cares. 371 | 372 | ### Skipping ahead: (end-request-session) 373 | 374 | When we're done with our request/response, it's time to clean up. We've got a nice function for that: 375 | 376 | ``` 377 | (de end-request-session (Request Session Buffer) 378 | (when Buffer (native "@" "free" NIL Buffer)) 379 | (ne-request-destroy Request) 380 | (del-auth-credentials Session) 381 | (end-session Session) ) 382 | ``` 383 | 384 | This free's the `Buffer` we allocated earlier using `malloc`. 385 | 386 | The real question is: when is this called? Let's get to that right now. 387 | 388 | ## Cleaning up errors 389 | 390 | Earlier, we discussed the ability to `(throw)` an error, and that's nice when something is there to catch it. But, what happens when that _thing_ doesn't know about the internals? Does it know how to cleanly end the request, end the session, free up manually allocated buffers? 391 | 392 | **Nope.** 393 | 394 | Our solution happens at the highest level in the most important function: `(req)`. 395 | 396 | ### (req) 397 | 398 | This is our public function which does it all. 399 | 400 | ```lisp 401 | [de req (Method Url Headers Filename Body) 402 | (let ((Session Path Request) (create-session-request Method Url Headers)) 403 | (let Buffer (set-request-body Request Body) 404 | (finally 405 | (end-request-session Request Session Buffer) 406 | (let Output (request-dispatch Request Session) 407 | (parse-response Request Url Output) ] 408 | ``` 409 | 410 | The first thing we do is obtain the request `Buffer` (which may possibly be empty). Next, we have this very useful [finally](http://software-lab.de/doc/refF.html#finally) call. That's our safety net. The first argument is the _"thing you do if an error is throw, or when you're done processing"_. The second argument is the _"processing"_ part. 411 | 412 | In other words, if a `(throw)` is called in our code, it will execute `(end-request-session)` which cleans memory and keeps things sane. Otherwise, it runs the `(request-dispatch)` and `(parse-response)`, then (finally) it runs `(end-request-session)` before returning the response from `(parse-response)`. 413 | 414 | Isn't that amazing? Sasuga PicoLisp. 415 | 416 | # The end 417 | 418 | That's pretty much all I have to explain about the HTTP(S) client for PicoLisp FFI bindings. I'm very open to providing more details about functionality I've skipped, so just file an [issue](https://github.com/aw/picolisp-https/issues/new) and I'll do my best. 419 | 420 | # License 421 | 422 | This work is licensed under a [Creative Commons Attribution-ShareAlike 4.0 International License](http://creativecommons.org/licenses/by-sa/4.0/). 423 | 424 | Copyright (c) 2015 Alexander Williams, Unscramble 425 | --------------------------------------------------------------------------------