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.

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.
c8e679ce · Ludovic Courtès · 8b59a735 · c8e679ce · c8e679ce
Commit c8e679ce authored Oct 08, 2019 by Ludovic Courtès
--- a/guix-jupyter-kernel.scm
+++ b/guix-jupyter-kernel.scm
@@ -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)

--- a/guix-kernel-demo.ipynb
+++ b/guix-kernel-demo.ipynb
@@ -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": {},

 %% Cell type:markdown id: tags:

 # Demo Guix Jupyter kernel

 Project source code: [Guix-kernel](https://gitlab.inria.fr/guix-hpc/guix-kernel).

 ![Guix-Jupyter](logo.png)

 ---
 ## Getting Started

 The `;;guix environment` _magic command_ allows you to create an execution environment containing a Jupyter kernel, or to run code in a previously-created environment.

 ---

 %% Cell type:markdown id: tags:

 ### Evaluating Code in a Jupyter Kernel

 Create an environment called `guile-kernel` containing the Guile kernel for Jupyter:

 %% Cell type:code id: tags:

 ``` scheme
 ;;guix pin 36cc160e721a764c16f53c6f7fbd9d09c581717e
 ```

 %% Cell type:code id: tags:

 ``` scheme
 ;;guix environment guile-kernel-env <- jupyter-guile-kernel
 ```

 %% Cell type:markdown id: tags:

 Run code in guile kernel:

 %% Cell type:code id: tags:

 ``` scheme
 ;;guix environment guile-kernel-env
 (define (list-environ env)
  (for-each (lambda (variable)
              (display variable)
              (newline))
            (environ)))
 ```

 %% Cell type:code id: tags:

 ``` scheme
 ;; Here we don't repeat "guix environment", so we use the
 ;; same environment as the previous cell.
 (list-environ (environ))
 ```

 %% Cell type:code id: tags:

 ``` scheme
 (define (random-art num)
  (define (new-char)
    (if (eq? (random 10) 5)
          (display "+")
          (display "."))
    (random-art (- num 1)))

  (if (not (zero? num))
    (new-char)))
 ```

 %% Cell type:markdown id: tags:

 Call the previously-defined function in the Guile kernel:

 %% Cell type:code id: tags:

 ``` scheme
 (random-art 3000)
 ```

 %% Cell type:markdown id: tags:

 ---

 ## Using IPython

 ### Create an environment with IPython

 %% Cell type:code id: tags:

 ``` scheme
 ;;guix environment my-ipython <- python-ipython python-ipykernel
 ```

 %% Cell type:markdown id: tags:

 ---

 ### Run code in the IPython kernel

 %% Cell type:code id: tags:

 ``` scheme
 ;;guix environment my-ipython
 # This is python lang !
 def hello ():
    print ("Hello Jupyter !")

 hello ()
 ```

 %% Cell type:code id: tags:

 ``` scheme
 ;;guix environment my-ipython
 import os
 os.getcwd()
 ```

 %% Cell type:code id: tags:

 ``` scheme
 os.getuid()
 ```

 %% Cell type:code id: tags:

 ``` scheme
 os.getpid()
 ```

 %% Cell type:code id: tags:

 ``` scheme
 os.listdir('/')
 ```

 %% Cell type:markdown id: tags:

 ## A Matplotlib environment

 %% Cell type:code id: tags:

 ``` scheme
 ;;guix environment matplotlib-env <- python-ipython python-ipykernel python-ipywidgets python-matplotlib
 ```

 %% Cell type:code id: tags:

 ``` scheme
 ;;guix environment matplotlib-env
 %matplotlib inline
 from matplotlib import pyplot as plt
 from matplotlib import style
 import random
 x = random.sample(range(1, 5000), 1000)
 num_bins = 100
 n, bins, patches = plt.hist(x, num_bins, facecolor='green', alpha=0.5)

 plt.title('Histogram Example')
 plt.xlabel('Values')
 plt.xlabel('Counts')
 plt.show()
 ```

 %% Cell type:code id: tags:

 ``` scheme
 ;;guix environment R <- r r-irkernel
 ```

 %% Cell type:code id: tags:

 ``` scheme
-;;guix environment R
 version
 ```

+%% Cell type:code id: tags:
+
+``` scheme
+;;guix download https://ftp.gnu.org/gnu/coreutils/coreutils-8.30.tar.xz e831b3a86091496cdba720411f9748de81507798f6130adeaef872d206e1b057
+;;
+;; Here we download a file and make it available in the 'R'
+;; environment created above.  We specify its SHA256 hash
+;; to ensure the integrity of the computations that follow.
+```
+
+%% Cell type:code id: tags:
+
+``` scheme
+file.info('coreutils-8.30.tar.xz')
+```
+
 %% Cell type:markdown id: tags:

 ### Using the built-in kernel for [GNU Guile](https://gnu.org/s/guile)

 %% Cell type:code id: tags:

 ``` scheme
 ;;guix environment guile <- guile
 ```

 %% Cell type:code id: tags:

 ``` scheme
 (version)
 ```

+%% Cell type:code id: tags:
+
+``` scheme
+(getaddrinfo "www.gnu.org")
+```
+
+%% Cell type:code id: tags:
+
+``` scheme
+(getpid)
+```
+
 %% Cell type:markdown id: tags:

 ---
 `guix-kernel-demo.ipynb` for guix-kernel.

 _Version 0.0.1_