├── .gitignore ├── trivial-download-test.asd ├── trivial-download.asd ├── .travis.yml ├── t └── trivial-download.lisp ├── README.md └── src └── trivial-download.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* -------------------------------------------------------------------------------- /trivial-download-test.asd: -------------------------------------------------------------------------------- 1 | (defsystem trivial-download-test 2 | :author "Fernando Borretti" 3 | :license "MIT" 4 | :description "Tests for trivial-download" 5 | :depends-on (:trivial-download 6 | :fiveam 7 | :clack 8 | :clack-v1-compat) 9 | :components ((:module "t" 10 | :components 11 | ((:file "trivial-download"))))) 12 | -------------------------------------------------------------------------------- /trivial-download.asd: -------------------------------------------------------------------------------- 1 | (defsystem trivial-download 2 | :author "Fernando Borretti " 3 | :maintainer "Fernando Borretti " 4 | :license "MIT" 5 | :version "0.3" 6 | :homepage "https://github.com/eudoxia0/trivial-download" 7 | :bug-tracker "https://github.com/eudoxia0/trivial-download/issues" 8 | :source-control (:git "git@github.com:eudoxia0/trivial-download.git") 9 | :depends-on (:drakma) 10 | :components ((:module "src" 11 | :components 12 | ((:file "trivial-download")))) 13 | :description "Download files from Common Lisp" 14 | :long-description 15 | #.(uiop:read-file-string 16 | (uiop:subpathname *load-pathname* "README.md"))) 17 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: common-lisp 2 | 3 | env: 4 | matrix: 5 | - LISP=sbcl COVERALLS=true 6 | 7 | install: 8 | # Install cl-travis 9 | - curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | bash 10 | # Coveralls support 11 | - git clone https://github.com/fukamachi/cl-coveralls ~/lisp/cl-coveralls 12 | 13 | script: 14 | - cl -l fiveam -l cl-coveralls 15 | -e '(setf fiveam:*debug-on-error* t 16 | fiveam:*debug-on-failure* t)' 17 | -e '(setf *debugger-hook* 18 | (lambda (c h) 19 | (declare (ignore c h)) 20 | (uiop:quit -1)))' 21 | -e '(coveralls:with-coveralls (:exclude (list "t")) 22 | (ql:quickload :trivial-download-test) 23 | (asdf:compile-system :trivial-download :force t))' 24 | 25 | notifications: 26 | email: 27 | - eudoxiahp@gmail.com 28 | -------------------------------------------------------------------------------- /t/trivial-download.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage trivial-download-test 3 | (:use :cl :fiveam)) 4 | (in-package :trivial-download-test) 5 | 6 | (def-suite downloads) 7 | (in-suite downloads) 8 | 9 | (defparameter +readme-pathname+ 10 | (asdf:system-relative-pathname :trivial-download #p"README.md")) 11 | 12 | (defparameter +readme-content+ 13 | (uiop:read-file-string +readme-pathname+)) 14 | 15 | (defparameter +download-pathname+ 16 | (asdf:system-relative-pathname :trivial-download #p"down.md")) 17 | 18 | ;;; The server will serve files from +tmp-directory+ 19 | 20 | (defparameter +server+ 21 | (make-instance 'clack.middleware.static: 22 | :path "/" 23 | :root (asdf:component-pathname (asdf:find-system :trivial-download)))) 24 | 25 | (defparameter *server-handler* nil) 26 | 27 | (defparameter +server-port+ 41111) 28 | 29 | (test set-up 30 | (finishes 31 | (setf *server-handler* 32 | (clack:clackup (lack:builder +server+) :port +server-port+)))) 33 | 34 | (test (download-file :depends-on set-up) 35 | (finishes 36 | (trivial-download:download "http://localhost:41111/README.md" 37 | +download-pathname+)) 38 | (is-true 39 | (probe-file +download-pathname+)) 40 | (is 41 | (equal +readme-content+ 42 | (uiop:read-file-string +download-pathname+)))) 43 | 44 | (test (missing-file :depends-on set-up) 45 | (finishes 46 | (delete-file +download-pathname+)) 47 | (signals trivial-download:http-error (trivial-download:download "http://localhost:41111/notafile" 48 | +download-pathname+)) 49 | (is-false (probe-file +download-pathname+))) 50 | 51 | (test (tear-down :depends-on set-up) 52 | (finishes 53 | (when (probe-file +download-pathname+) 54 | (delete-file +download-pathname+))) 55 | (finishes 56 | (clack:stop *server-handler*))) 57 | 58 | (run! 'downloads) 59 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # trivial-download 2 | 3 | [![Build Status](https://travis-ci.org/eudoxia0/trivial-download.svg?branch=master)](https://travis-ci.org/eudoxia0/trivial-download) 4 | [![Coverage Status](https://coveralls.io/repos/eudoxia0/trivial-download/badge.svg?branch=master)](https://coveralls.io/r/eudoxia0/trivial-download?branch=master) 5 | [![Quicklisp](http://quickdocs.org/badge/trivial-download.svg)](http://quickdocs.org/trivial-download/) 6 | 7 | trivial-download allows you to download files from the Internet from Common 8 | Lisp. It even provides a progress bar. 9 | 10 | # Usage 11 | 12 | ```lisp 13 | cl-user> (download "http://www.google.com/robots.txt" "/tmp/robots.txt") 14 | Downloading "http://www.google.com/robots.txt" (Unknown size) 15 | t 16 | cl-user> (download "https://github.com/favicon.ico" "/tmp/favicon.ico") 17 | Downloading "https://github.com/favicon.ico" (6.518 kB) 18 | .........10%.........20%.........30%.........40%.........50%.........60%.........70%.........80%.........90%.........100%t 19 | ``` 20 | 21 | # Documentation 22 | 23 | You probably want the `download` function, which downloads files from the 24 | network to the local disk. If you want more control over that -- like, say, 25 | writing the downloaded bytes to a database instead -- you want the 26 | `with-download` macro. 27 | 28 | `trivial-download` downloads everything in chunks that are `*chunk-size*` bytes 29 | long. `*chunk-size*`, by default, is 256. 30 | 31 | * [Function] `download` *(url output)* 32 | 33 | Downloads the content of `url` and writes it to `output`. The file is written as 34 | it is downloaded, chunk-by-chunk, not downloaded into memory and written at 35 | once. 36 | 37 | * [Macro] `with-download` *(url (file-size total-bytes-read array stream) &rest body)* 38 | 39 | Downloads the contents of `url`, executing `body` in every chunk. 40 | 41 | The extra arguments are: 42 | 43 | - `stream`: A `flexi-io-stream` bivalent stream. 44 | - `file-size`: The size, in bytes, of the file to download. 45 | - `bytes-read`: The number of bytes read. 46 | - `array`: As every chunk is downloaded, its contents are written to `array`. 47 | 48 | Example: 49 | 50 | ```lisp 51 | (with-download "https://github.com/favicon.ico" 52 | ;; Do something 53 | ) 54 | ``` 55 | 56 | * [Macro] `with-download-progress` *(url (file-size total-bytes-read array stream) &rest body)* 57 | 58 | The same as `with-download`, only this prints progress information while 59 | downloading. 60 | 61 | # License 62 | 63 | Copyright (c) 2014-2015 Fernando Borretti (eudoxiahp@gmail.com) 64 | 65 | Licensed under the MIT License. 66 | -------------------------------------------------------------------------------- /src/trivial-download.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage trivial-download 3 | (:use :cl) 4 | (:export :*chunk-size* 5 | :file-size 6 | :with-download 7 | :with-download-progress 8 | :download 9 | :http-error 10 | :it)) 11 | (in-package :trivial-download) 12 | 13 | (defparameter *chunk-size* 256 14 | "Files are downloaded in chunks of this many bytes.") 15 | 16 | (define-condition http-error (error) 17 | ((code :initarg :code :accessor response-code)) 18 | (:report (lambda (c s) 19 | (format s "HTTP error, response code ~S." (response-code c))))) 20 | 21 | (defun http-request (url &rest args) 22 | (let* ((vals (multiple-value-list (apply #'drakma:http-request url args))) 23 | (code (second vals))) 24 | (unless (= 200 code) 25 | (error 'http-error :code code)) 26 | (values-list vals))) 27 | 28 | (defun file-size (headers) 29 | "Take the headers of a http request, return the size (in bytes)." 30 | (handler-case 31 | (parse-integer 32 | (cdr 33 | (assoc :content-length 34 | (third (multiple-value-list 35 | headers))))) 36 | (t () nil))) 37 | 38 | (defparameter +size-symbol-map+ 39 | (list (cons 1000000000000 "TB") 40 | (cons 1000000000 "GB") 41 | (cons 1000000 "MB") 42 | (cons 1000 "kB") 43 | (cons 1 "B"))) 44 | 45 | (defun human-file-size (size) 46 | "Take a file size (in bytes), return it as a human-readable string." 47 | (let ((pair (loop for pair in +size-symbol-map+ 48 | if (or (>= size (car pair)) 49 | (= (car pair) 1)) 50 | return pair))) 51 | (format nil "~f ~A" (/ size (car pair)) (cdr pair)))) 52 | 53 | (defun percentage (total-bytes current-bytes) 54 | (if (= current-bytes 0) 55 | 100 56 | (floor (/ (* current-bytes 100) total-bytes)))) 57 | 58 | (defmacro with-download (url (file-size total-bytes-read array stream &key quiet) 59 | &body body) 60 | "Execute body at every chunk that is downloaded." 61 | `(let* ((response (multiple-value-list 62 | (http-request ,url 63 | :want-stream t))) 64 | (,file-size (file-size (third response))) 65 | (,total-bytes-read 0) 66 | (,array (make-array *chunk-size* :element-type '(unsigned-byte 8))) 67 | (,stream (car response))) 68 | (unless ,quiet 69 | (format t "Downloading ~S (~A)~&" ,url (if ,file-size 70 | (human-file-size ,file-size) 71 | "Unknown size"))) 72 | (finish-output nil) 73 | ;; We read the file in `*chunk-size*`-byte chunks by using `read-sequence` 74 | ;; to fill `array`. The return value of `read-sequence`, in this context, 75 | ;; is the number of bytes read. we know we've reached the end of file when 76 | ;; the number of bytes read is less than `*chunk-size*` 77 | (loop do 78 | (let ((bytes-read-this-chunk (read-sequence ,array ,stream))) 79 | (incf ,total-bytes-read bytes-read-this-chunk) 80 | ,@body 81 | (if (< bytes-read-this-chunk *chunk-size*) 82 | (return)))) 83 | (close ,stream))) 84 | 85 | (defmacro with-download-progress (url (file-size total-bytes-read array stream &key quiet) 86 | &body body) 87 | "Like with-download but with a progress bar." 88 | (alexandria:with-gensyms (last-percentage progress) 89 | `(let ((,last-percentage 0)) 90 | (with-download ,url (,file-size ,total-bytes-read ,array ,stream :quiet ,quiet) 91 | (progn 92 | (if ,file-size 93 | (let ((,progress (percentage ,file-size ,total-bytes-read))) 94 | (if (> ,progress ,last-percentage) 95 | (progn 96 | (if (eql 0 (mod ,progress 10)) 97 | (format t "~D%" ,progress) 98 | (format t ".")) 99 | (finish-output nil))) 100 | (setf ,last-percentage ,progress))) 101 | ,@body))))) 102 | 103 | (defun download (url output &key quiet) 104 | "Download a file and save it to a pathname. Directories containing `output` 105 | are created if they don't exist." 106 | (ensure-directories-exist (uiop:pathname-directory-pathname output)) 107 | (with-open-file (file output 108 | :direction :output 109 | :if-does-not-exist :create 110 | :if-exists :supersede 111 | :element-type '(unsigned-byte 8)) 112 | (if quiet 113 | (with-download url (file-size total-bytes-read array stream :quiet quiet) 114 | (write-sequence array file :end bytes-read-this-chunk)) 115 | (with-download-progress url (file-size total-bytes-read array stream 116 | :quiet quiet) 117 | (write-sequence array file :end bytes-read-this-chunk))))) 118 | --------------------------------------------------------------------------------