You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

157 lines
5.5 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (guix scripts repl)
  19. #:use-module (guix ui)
  20. #:use-module (guix scripts)
  21. #:use-module (guix repl)
  22. #:use-module (guix utils)
  23. #:use-module (guix packages)
  24. #:use-module (gnu packages)
  25. #:use-module (srfi srfi-1)
  26. #:use-module (srfi srfi-37)
  27. #:use-module (ice-9 match)
  28. #:use-module (rnrs bytevectors)
  29. #:autoload (system repl repl) (start-repl)
  30. #:autoload (system repl server)
  31. (make-tcp-server-socket make-unix-domain-server-socket)
  32. #:export (guix-repl))
  33. ;;; Commentary:
  34. ;;;
  35. ;;; This command provides a Guile REPL
  36. (define %default-options
  37. `((type . guile)))
  38. (define %options
  39. (list (option '(#\h "help") #f #f
  40. (lambda args
  41. (show-help)
  42. (exit 0)))
  43. (option '(#\V "version") #f #f
  44. (lambda args
  45. (show-version-and-exit "guix repl")))
  46. (option '(#\t "type") #t #f
  47. (lambda (opt name arg result)
  48. (alist-cons 'type (string->symbol arg) result)))
  49. (option '("listen") #t #f
  50. (lambda (opt name arg result)
  51. (alist-cons 'listen arg result)))))
  52. (define (show-help)
  53. (display (G_ "Usage: guix repl [OPTIONS...]
  54. Start a Guile REPL in the Guix execution environment.\n"))
  55. (display (G_ "
  56. -t, --type=TYPE start a REPL of the given TYPE"))
  57. (newline)
  58. (display (G_ "
  59. -h, --help display this help and exit"))
  60. (display (G_ "
  61. -V, --version display version information and exit"))
  62. (newline)
  63. (show-bug-report-information))
  64. (define user-module
  65. ;; Module where we execute user code.
  66. (let ((module (resolve-module '(guix-user) #f #f #:ensure #t)))
  67. (beautify-user-module! module)
  68. module))
  69. (define (call-with-connection spec thunk)
  70. "Dynamically-bind the current input and output ports according to SPEC and
  71. call THUNK."
  72. (if (not spec)
  73. (thunk)
  74. ;; Note: the "PROTO:" prefix in SPEC is here so that we can eventually
  75. ;; parse things like "fd:123" in a non-ambiguous way.
  76. (match (string-index spec #\:)
  77. (#f
  78. (leave (G_ "~A: invalid listen specification~%") spec))
  79. (index
  80. (let ((protocol (string-take spec index))
  81. (address (string-drop spec (+ index 1))))
  82. (define socket
  83. (match protocol
  84. ("tcp"
  85. (make-tcp-server-socket #:port (string->number address)))
  86. ("unix"
  87. (make-unix-domain-server-socket #:path address))
  88. (_
  89. (leave (G_ "~A: unsupported protocol family~%")
  90. protocol))))
  91. (listen socket 10)
  92. (let loop ()
  93. (match (accept socket)
  94. ((connection . address)
  95. (if (= AF_UNIX (sockaddr:fam address))
  96. (info (G_ "accepted connection~%"))
  97. (info (G_ "accepted connection from ~a~%")
  98. (inet-ntop (sockaddr:fam address)
  99. (sockaddr:addr address))))
  100. (dynamic-wind
  101. (const #t)
  102. (lambda ()
  103. (parameterize ((current-input-port connection)
  104. (current-output-port connection))
  105. (thunk)))
  106. (lambda ()
  107. (false-if-exception (close-port connection))
  108. (info (G_ "connection closed~%"))))))
  109. (loop)))))))
  110. (define (guix-repl . args)
  111. (define opts
  112. ;; Return the list of package names.
  113. (args-fold* args %options
  114. (lambda (opt name arg result)
  115. (leave (G_ "~A: unrecognized option~%") name))
  116. (lambda (arg result)
  117. (leave (G_ "~A: extraneous argument~%") arg))
  118. %default-options))
  119. (with-error-handling
  120. (let ((type (assoc-ref opts 'type)))
  121. (call-with-connection (assoc-ref opts 'listen)
  122. (lambda ()
  123. (case type
  124. ((guile)
  125. (save-module-excursion
  126. (lambda ()
  127. (set-current-module user-module)
  128. (and=> (getenv "HOME")
  129. (lambda (home)
  130. (let ((guile (string-append home "/.guile")))
  131. (when (file-exists? guile)
  132. (load guile)))))
  133. ;; Do not exit repl on SIGINT.
  134. ((@@ (ice-9 top-repl) call-with-sigint)
  135. (lambda ()
  136. (start-repl))))))
  137. ((machine)
  138. (machine-repl))
  139. (else
  140. (leave (G_ "~a: unknown type of REPL~%") type))))))))
  141. ;; Local Variables:
  142. ;; eval: (put 'call-with-connection 'scheme-indent-function 1)
  143. ;; End: