Commit c8e679ce authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

kernel: Add ";;guix download" magic.

* guix-jupyter-kernel.scm (link/copy, handle-download): New procedures.
(reply-execute-request): Handle ";;guix download".
(%magic-commands): New variable.
(reply-complete-request): Honor it.
* guix-kernel-demo.ipynb: Add example.
parent 8b59a735
......@@ -23,6 +23,7 @@
(srfi srfi-13)
(srfi srfi-19)
(srfi srfi-26)
(srfi srfi-34)
(srfi srfi-71)
(rnrs bytevectors)
(ice-9 match)
......@@ -31,11 +32,13 @@
(guix gexp)
(guix store)
(guix channels)
(guix download)
(guix derivations)
(guix inferior)
(guix monads)
(guix profiles)
(gcrypt base16)
(gcrypt hash)
(jupyter messages)
(jupyter kernels)
(jupyter servers)
......@@ -184,6 +187,92 @@ CHANNELS."
(git-error-message error) ".")
count))
(define (link/copy source target)
"Make the file SOURCE available as TARGET, either by creating a hard link
or otherwise by copying it. If TARGET already exists, delete it."
(catch 'system-error
(lambda ()
(link source target))
(lambda args
(cond ((= EXDEV (system-error-errno args))
(copy-file source target)
(utime target 1 1 1 1))
((= EEXIST (system-error-errno args))
(delete-file target)
(link/copy source target))
(else
(apply throw args))))))
(define* (handle-download kernel kind message state
#:key
url (hash-algo "sha256") hash
(file (basename url)))
"Handle a request to download FILE from URL, which should have the given
HASH of type HASH-ALGO."
(define algo
(lookup-hash-algorithm (string->symbol hash-algo)))
(define hash/bv
(base16-string->bytevector hash))
(define count
(proxy-state-execution-count state))
(cond ((not algo)
(reply-html kernel message
(sxml->html-string
`(bold "Unknown hash algorithm."))
count)
state)
((not hash/bv)
(reply-html kernel message
(sxml->html-string
`(bold "Invalid hexadecimal string."))
count)
state)
((not (= (bytevector-length hash/bv) (hash-size algo)))
(reply-html kernel message
(sxml->html-string
'(bold "Invalid hash length."))
count)
state)
((not (proxy-state-default-environment state))
(reply-html kernel message
(sxml->html-string
'(bold "No current environment to download to."))
count))
(else
(guard (c ((store-protocol-error? c)
(reply-html kernel message
(sxml->html-string
`(bold ,(store-protocol-error-message c)))
count)
state))
(format/log "downloading from '~a'...~%" url)
(let* ((store (proxy-state-store state))
(item (run-with-store store
(mlet %store-monad
((drv (url-fetch url (string->symbol hash-algo)
hash/bv file)))
(mbegin %store-monad
(built-derivations (list drv))
(return (derivation->output-path drv))))))
(environment (proxy-state-default-environment state))
(target (lookup-proxied environment state))
(home (assq-ref (kernel-properties target) 'home)))
(format/log "copying '~a' to '~a/~a'~%"
item home file)
(link/copy item (string-append home "/" file))
(reply-html kernel message
(sxml->html-string
`(bold "File " (code ,file)
" from "
(a (@ (href ,url)) ,url)
" is now available in environment "
(code ,environment) "."))
count)
(increment-execution-count state))))))
(define* (create-environment name specs state
#:key kernel message)
"Spawn a new execution environment called NAME and containing SPECS, a list
......@@ -329,6 +418,16 @@ stripped."
(reply-for-channel-failure kernel message channels error
#:count count)
state))))
((";;guix" "download" url hash)
(handle-download kernel kind message state
#:url url #:hash hash))
((";;guix" "download" url algo hash)
(handle-download kernel kind message state
#:url url #:hash-algo algo #:hash hash))
((";;guix" "download" url algo hash "->" file)
(handle-download kernel kind message state
#:url url #:hash-algo algo #:hash hash
#:file file))
((";;guix" _ ...)
(reply-html kernel message
(sxml->html-string
......@@ -364,6 +463,10 @@ to execute:"
((";;guix" "environment" name) name)
(_ #f)))
(define %magic-commands
;; The ";;guix" magic commands.
'("download" "environment" "pin"))
(define (reply-complete-request kernel kind message state)
"Reply to a \"complete_request\" message--i.e., a completion request.
Return STATE."
......@@ -392,7 +495,7 @@ Return STATE."
;; This is a completion request on a ";;guix" magic.
(match (string-split (string-take first cursor) #\space)
((";;guix" command)
(send-completion-reply '("environment" "pin")
(send-completion-reply %magic-commands
(- cursor (string-length command))
cursor)
state)
......
......@@ -243,10 +243,31 @@
"metadata": {},
"outputs": [],
"source": [
";;guix environment R\n",
"version"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
";;guix download https://ftp.gnu.org/gnu/coreutils/coreutils-8.30.tar.xz e831b3a86091496cdba720411f9748de81507798f6130adeaef872d206e1b057\n",
";;\n",
";; Here we download a file and make it available in the 'R'\n",
";; environment created above. We specify its SHA256 hash\n",
";; to ensure the integrity of the computations that follow."
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"file.info('coreutils-8.30.tar.xz')"
]
},
{
"cell_type": "markdown",
"metadata": {},
......@@ -272,6 +293,24 @@
"(version)"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"(getaddrinfo \"www.gnu.org\")"
]
},
{
"cell_type": "code",
"execution_count": null,
"metadata": {},
"outputs": [],
"source": [
"(getpid)"
]
},
{
"cell_type": "markdown",
"metadata": {},
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment