bug#22588: root: UNEXPECTED INCONSISTENCY; RUN fsck MANUALLY

[Ludovic Courtès]

Mark H Weaver <address@hidden> skribis:

> address@hidden (Ludovic Courtès) writes:

[...]

>> Currently there’s no Bash in the initrd.  Should we add one?  Our
>> ‘bash-static’ package takes 1.4 MiB (I don’t think we can make it
>> smaller.)
>
> I'm not sure it would help much without also adding 'coreutils'.

Good point.

>> Another idea that comes to mind: what about providing a “shell” language
>> in Guile?  It would automatically tokenize what the user types in and
>> convert it to (system* …), plus it would have a few built-in commands
>> like ‘cd’ and ‘ls’.
>
> I like the idea of having something like this in Guile, but I'm not sure
> we should rush to implement a half-baked solution.

OTOH, hacking it is very tempting, like:

--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> ,use (guix build bournish)
scheme@(guile-user)> ,bournish
Happy hacking with Bournish!  To switch back, type `,L scheme'.
bournish@(guile-user)> ls
.                         gnu-dist.go               r-build-system.go         
..                        gnu-dist.scm              r-build-system.scm        
activation.scm~           gnu-dist.scm~             relocate.scm~             
bournish.scm              gnu.scm~                  rpath.go                  
bournish.scm~             graft.go                  rpath.scm                 
cmake-build-system.go     graft.scm                 rpath.scm~                
cmake-build-system.scm    graft.scm~                ruby-build-system.go      
cvs.go                    graft.scm.115             ruby-build-system.scm     
cvs.scm                   graft.scm.bak             ruby-build-system.scm.orig
download.go               gremlin.go                ruby-build-system.scm.rej 
download.scm              gremlin.scm               store-copy.go             
download.scm~             gremlin.scm~              store-copy.scm            
download.scm.bak          haskell-build-system.go   store-copy.scm~           
emacs-build-system.go     haskell-build-system.scm  svn.go                    
emacs-build-system.scm    http.scm~                 svn.scm                   
emacs-utils.go            install.scm~              syscalls.go               
emacs-utils.scm           linux-initrd.scm~         syscalls.scm              
ftp.scm~                  perl-build-system.go      syscalls.scm~             
git.go                    perl-build-system.scm     union.go                  
git.scm                   perl-build-system.scm~    union.scm                 
git.scm~                  profile.go                union.scm~                
glib-or-gtk-build-system.gprofile.scm~              url.scm~                  
glib-or-gtk-build-system.sprofiles.go               utils.go                  
gnome-build-system.scm    profiles.scm              utils.scm                 
gnome-build-system.scm~   profiles.scm~             utils.scm~                
gnu-build-system.go       pull.go                   vm.scm~                   
gnu-build-system.scm      pull.scm                  waf-build-system.go       
gnu-build-system.scm~     pull.scm~                 waf-build-system.scm      
gnu-build-system.scm.bak  python-build-system.go                              
gnu-cross-build.scm~      python-build-system.scm                             
bournish@(guile-user)> cd /
bournish@(guile-user)> pwd
$2 = "/"
bournish@(guile-user)> echo $PATH $LANGUAGE
$3 = 
("/home/ludo/soft/bin:/home/ludo/.opam/system/bin:/home/ludo/.guix-profile/bin:/home/ludo/.guix-profile/sbin:/run/setuid-programs:/run/current-system/profile/bin:/run/current-system/profile/sbin"
 "eo")
bournish@(guile-user)> touch --version
touch (GNU coreutils) 8.24
Copyright © 2015 Free Software Foundation, Inc.
Ĉi tiu estas libera programaro: vi rajtas ĝin ŝanĝi kaj redistribui.
La ĝusta permesilo estas GPLv3+: GNU GPL versio 3 aŭ sekva;
por la kompleta (angla) teksto vidu <http://gnu.org/licenses/gpl.html>.
Ĉi tiu programaro ne garantiatas, ene de la limoj de la leĝo.

Verkita de Paul Rubin, Arnold Robbins, Jim Kingdon,
David MacKenzie kaj Randy Smith.
$4 = 0
bournish@(guile-user)> ,L scheme
Happy hacking with Scheme!  To switch back, type `,L bournish'.
--8<---------------cut here---------------end--------------->8---

:-)

The point is, if we can allow users to avoid typing in parentheses and
long procedure names and quoted argument lists when all they want is to
run fsck, we should do that.

> When we have something decent along the lines of Scsh, then
> definitely!

Scsh makes it super easy to deal with Unix processes, redirections, and
all that (it would be awesome to use it on the build side), but AFAIK it
doesn’t try to provide a Bourne-like interface, which is what we need
here.

So, WDYT?  :-)

Ludo’.

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <address@hidden>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build bournish)
  #:use-module (system base language)
  #:use-module (system base compile)
  #:use-module (system repl command)
  #:use-module (system repl common)
  #:use-module (ice-9 rdelim)
  #:use-module (ice-9 match)
  #:use-module (ice-9 ftw)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:export (%bournish-language))

(define (expand-variable str)
  ;; XXX: No support for "${VAR}".
  (if (string-prefix? "$" str)
      (or (getenv (string-drop str 1)) "")
      str))

(define* (display-tabulated lst
                             #:key (columns 3)
                             (column-width (/ 78 columns)))
  "Display the list of string LST in COLUMNS columns of COLUMN-WIDTH
characters."
  (define len (length lst))
  (define pad
    (if (zero? (modulo len columns))
        0
        columns))
  (define items-per-column
    (quotient (+ len pad) columns))
  (define items (list->vector lst))

  (let loop ((indexes (unfold (cut >= <> columns)
                              (cut * <> items-per-column)
                              1+
                              0)))
    (unless (>= (first indexes) items-per-column)
      (for-each (lambda (index)
                  (let ((item (if (< index len)
                                  (vector-ref items index)
                                  "")))
                    (display (string-pad-right item column-width))))
                indexes)
      (newline)
      (loop (map 1+ indexes)))))

(define builtin-ls
  (case-lambda
    (()
     (display-tabulated (scandir ".")))
    (files
     (let ((files (filter (lambda (file)
                            (catch 'system-error
                              (lambda ()
                                (lstat file))
                              (lambda args
                                (let ((errno (system-error-errno args)))
                                  (format (current-error-port) "~a: ~a~%"
                                          file (strerror errno))
                                  #f))))
                          files)))
       (display-tabulated files)))))

(define %not-colon (char-set-complement (char-set #\:)))
(define (executable-path)
  (match (getenv "PATH")
    (#f  '())
    (str (string-tokenize str %not-colon))))

(define (read-bournish port env)
  (match (map expand-variable (string-tokenize (read-line port)))
    (("echo" strings ...)
     `',strings)
    (("cd" dir)
     `(chdir ,dir))
    (("pwd")
     `(getcwd))
    (("ls" args ...)
     `((@@ (guix build bournish) builtin-ls) ,@args))
    (("which" command)
     `(search-path ((@@ (guix build bournish) executable-path))
                   ,command))
    (("help" _ ...)
     (display "\
Hello, this is Bournish, a minimal Bourne-like shell in Guile!

The shell is good enough to navigate the file system and run commands but not
much beyond that.  It is meant to be used as a rescue shell in the initial RAM
disk and is probably not very useful apart from that.  It has a few built-in
commands such as 'ls' and 'cd'; it lacks globbing, pipes---everything.\n"))
    ((command args ...)
     (let ((command (if (string-prefix? "\\" command)
                        (string-drop command 1)
                        command)))
       `(system* ,command ,@args)))))

(define %bournish-language
  (let ((scheme (lookup-language 'scheme)))
    (make-language #:name 'bournish
                   #:title "Bournish"
                   #:reader read-bournish
                   #:compilers (language-compilers scheme)
                   #:decompilers (language-decompilers scheme)
                   #:evaluator (language-evaluator scheme)
                   #:printer (language-printer scheme)
                   #:make-default-environment
                   (language-make-default-environment scheme))))

;; XXX: ",L bournish" won't work unless we call our module (language bournish
;; spec), which is kinda annoying, so provide another meta-command.
(define-meta-command ((bournish guix) repl)
  "bournish
Switch to the Bournish language."
  (let ((current (repl-language repl)))
    (format #t "Happy hacking with ~a!  To switch back, type `,L ~a'.\n"
            (language-title %bournish-language)
            (language-name current))
    (current-language %bournish-language)
    (set! (repl-language repl) %bournish-language)))