From: Doug Coleman Date: Sun, 24 Mar 2024 20:59:10 +0000 (-0500) Subject: http.download: move download words to their own vocabulary X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=3f30c7bffc2ec0124f9380316f181045b725d4c8 http.download: move download words to their own vocabulary --- diff --git a/basis/http/client/client-docs.factor b/basis/http/client/client-docs.factor index fcedb182c0..f112a56816 100644 --- a/basis/http/client/client-docs.factor +++ b/basis/http/client/client-docs.factor @@ -43,21 +43,6 @@ HELP: { $description "Constructs an HTTP TRACE request for the requested URL." } { $notes "The request can be passed on to " { $link http-request } ", possibly after cookies and headers are set." } ; -HELP: download -{ $values { "url" { $or url string } } } -{ $description "Downloads the contents of the URL to a file in the " { $link current-directory } " having the same file name." } -{ $errors "Throws an error if the HTTP request fails." } ; - -HELP: download-to -{ $values { "url" { $or url string } } { "file" "a pathname string" } } -{ $description "Downloads the contents of the URL to a file with the given pathname." } -{ $errors "Throws an error if the HTTP request fails." } ; - -HELP: ?download-to -{ $values { "url" { $or url string } } { "file" "a pathname string" } } -{ $description "Version of " { $link download-to } " that only downloads if " { $snippet "file" } " does not exist." } -{ $errors "Throws an error if the HTTP request fails." } ; - HELP: http-get { $values { "url" { $or url string } } { "response" response } { "data" sequence } } { $description "Downloads the contents of a URL." } @@ -171,12 +156,8 @@ ARTICLE: "http.client.get" "GET requests with the HTTP client" http-get http-get* } -"Utilities to retrieve a " { $link url } " and save the contents to a file:" -{ $subsections - download - download-to - ?download-to -} +"To download to a file, see the " { $link "http.download" } " vocabulary." + "Advanced usage involves constructing a " { $link request } ", which allows " { $link "http.cookies" } " and " { $link "http.headers" } " to be set:" { $subsections diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index e709f5ff88..f0b86916b0 100644 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -293,28 +293,6 @@ SYMBOL: request-socket : http-get* ( url -- response data ) http-request* ; -: file-too-old? ( file duration -- ? ) - over file-exists? [ - [ file-info created>> ago ] dip after? - ] [ 2drop t ] if ; - -: download-name ( url -- name ) - present file-name "?" split1 drop "/" ?tail drop ; - -: download-to ( url file -- ) - binary [ - [ write ] with-http-request drop - ] with-file-writer ; - -: ?download-to ( url file -- ) - dup file-exists? [ 2drop ] [ download-to ] if ; - -: ?download-update-to ( url file duration -- ) - 2dup file-too-old? [ drop download-to ] [ 3drop ] if ; - -: download ( url -- ) - dup download-name download-to ; - : ( post-data url -- request ) "POST" swap >>post-data ; diff --git a/basis/http/download/authors.txt b/basis/http/download/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/http/download/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/http/download/download-docs.factor b/basis/http/download/download-docs.factor new file mode 100644 index 0000000000..72dc7b2d9d --- /dev/null +++ b/basis/http/download/download-docs.factor @@ -0,0 +1,28 @@ +! Copyright (C) 2024 Doug Coleman. +! See https://factorcode.org/license.txt for BSD license. +USING: calendar help.markup help.syntax io.pathnames kernel math +strings urls ; +IN: http.download + +HELP: download +{ $values { "url" { $or url string } } { "path" "a pathname string" } } +{ $description "Downloads the contents of the URL to a file in the " { $link current-directory } " having the same file name and returns the pathname." } +{ $errors "Throws an error if the HTTP request fails." } ; + +HELP: download-to +{ $values { "url" { $or url string } } { "file" "a pathname string" } { "path" "a pathname string" } } +{ $description "Downloads the contents of the URL to a file with the given pathname and returns the pathname." } +{ $errors "Throws an error if the HTTP request fails." } ; + + +ARTICLE: "http.download" "HTTP Download Utilities" +"The " { $vocab-link "http.download" } " vocabulary provides utilities for downloading files from the web." + +"Utilities to retrieve a " { $link url } " and save the contents to a file:" +{ $subsections + download + download-to +} +; + +ABOUT: "http.download" diff --git a/basis/http/download/download.factor b/basis/http/download/download.factor new file mode 100644 index 0000000000..36d2b0e7b3 --- /dev/null +++ b/basis/http/download/download.factor @@ -0,0 +1,90 @@ +! Copyright (C) 2024 Doug Coleman. +! See https://factorcode.org/license.txt for BSD license. +USING: accessors calendar checksums combinators.short-circuit +http.client io io.backend io.directories io.encodings.binary +io.files io.files.info io.files.unique io.pathnames kernel math +math.order math.parser present sequences shuffle splitting ; +IN: http.download + +: file-too-old-or-not-exists? ( file duration -- ? ) + [ ?file-info [ created>> ] ?call ] + [ ago ] bi* + over [ before? ] [ 2drop t ] if ; + +: delete-when-old ( file duration -- deleted? ) + dupd file-too-old-or-not-exists? [ ?delete-file t ] [ drop f ] if ; + +: file-matches-checksum? ( file checksum-type bytes -- ? ) + [ checksum-file ] dip = ; + +: delete-when-checksum-mismatches ( file checksum-type bytes -- deleted? ) + dupdd file-matches-checksum? [ drop f ] [ ?delete-file t ] if ; + +: file-size= ( path n -- ? ) [ ?file-info [ size>> ] ?call ] dip = ; + +: file-zero-size? ( path -- ? ) 0 file-size= ; + +: delete-when-zero-size ( path -- deleted? ) + dup file-zero-size? [ ?delete-file t ] [ drop f ] if ; + +: delete-when-file-size-mismatches? ( file size -- deleted? ) + dupd file-size= [ drop f ] [ ?delete-file t ] if ; + +: download-name ( url -- name ) + present file-name "?" split1 drop "/" ?tail drop ; + +number + [ 1 + number>string append ] + [ ".1" 3append ] if + ] bi ; + +: ?parenthesis-number ( str -- n/str ? ) + dup { [ "(" head? ] [ ")" tail? ] } 1&& + [ rest but-last ?string>number ] [ f ] if ; + +: increment-file-name ( path -- path' ) + [ + file-stem " " split1-last + ?parenthesis-number + [ 1 + number>string "(" ")" surround " " glue ] + [ "(1)" append " " glue ] if + ] [ + file-extension + ] bi "." glue ; + +: find-next-incremented-name ( path -- path' ) + dup file-exists? [ + increment-file-name find-next-incremented-name + ] when ; + +: next-download-name ( url -- name ) + download-name find-next-incremented-name ; + +: http-write-request ( url -- ) + [ write ] with-http-request drop ; + +: download-temporary-name ( url -- prefix suffix ) + [ "temp." ".temp" ] dip download-name prepend ; + +: download-file-to ( url file -- path ) + [ + [ download-temporary-name binary ] keep + '[ _ http-write-request ] with-unique-file-writer + ] dip [ move-file ] keep ; + +PRIVATE> + +: download-to ( url file -- path ) + dup file-exists? [ nip ] [ download-file-to ] if ; + +: download-outdated-to ( url file duration -- path ) + 2dup delete-when-old [ drop download-to ] [ drop nip ] if ; + +: download ( url -- path ) + dup download-name download-to ; diff --git a/basis/http/server/requests/requests.factor b/basis/http/server/requests/requests.factor index 677a2948a4..fce1477f2a 100644 --- a/basis/http/server/requests/requests.factor +++ b/basis/http/server/requests/requests.factor @@ -48,11 +48,11 @@ upload-limit [ 200,000,000 ] initialize : parse-content-length-safe ( request -- content-length ) "content-length" header [ - dup string>number [ - nip dup 0 upload-limit get between? [ + ?string>number [ + dup 0 upload-limit get between? [ invalid-content-length ] unless - ] [ invalid-content-length ] if* + ] [ invalid-content-length ] if ] [ content-length-missing ] if* ; : parse-content ( request content-type -- post-data )