From 5b5aaa1031497a9a6d85e45ba2924d54f233d7ec Mon Sep 17 00:00:00 2001 From: Justus Winter <4winter@informatik.uni-hamburg.de> Date: Mon, 9 Mar 2015 20:51:53 +0100 Subject: [PATCH hurd 10/10] pull code from livecd XXX document --- bootshell/runsystem.scm | 206 +++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 170 insertions(+), 36 deletions(-) diff --git a/bootshell/runsystem.scm b/bootshell/runsystem.scm index befb07c..af6e943 100644 --- a/bootshell/runsystem.scm +++ b/bootshell/runsystem.scm @@ -115,27 +115,65 @@ (proc->mark-important! p) (proc->mark-exec! p))) -(define (bootstrap rootfs-args exec-args) - (log "Hurd server bootstrap: ") +(define (path->string x) + (if (string? x) x (symbol->string x))) + +(define (start-active-translator path args) + (log (path->string path) " ") + (bind path (start-translator (task-create mach-task-self 0) args))) + +(define messages '()) +(define (log . args) + (set! messages (append messages args)) + (for-each display args)) +(define (replay-log) + (for-each display messages)) + +(define rootfs-control MACH_PORT_NULL) +(define (traditional-first-stage) (log "rootfs ") - (let ((rootfs-control (bind-root (resume-translator rootfs-server-task + (set! rootfs-control (bind-root (resume-translator rootfs-server-task '()))) + (log "/servers/exec ") + (bind "/servers/exec" (resume-translator exec-server-task '()))) + +(define (first-stage rootfs-device) + (set! exec-server-task (task-create mach-task-self 0)) + (let + ((rootfs-args + `("rootfs" + ,(make-arg "host-priv-port" rootfs-server-task host-priv) + ,(make-arg "device-master-port" rootfs-server-task device-master) + ,(make-arg "exec-server-task" rootfs-server-task exec-server-task) + "-T" "typed" ,(string-append "device:" rootfs-device)))) + (log "rootfs ") + (set! rootfs-control (bind-root (resume-translator rootfs-server-task rootfs-args))) - (startup-control (mach-port-allocate mach-task-self - MACH_PORT_RIGHT_RECEIVE)) - (proc-task (task-create mach-task-self 0)) - (auth-task (task-create mach-task-self 0)) - ;; Projections for the cookies returned by bootstrap-*. - (:reply car) (:replyPoly cadr) (:server caddr)) + (log "/servers/exec ") + (task-set-name exec-server-task "/hurd/exec") + (task-suspend exec-server-task) + (elf-exec exec-server-task + `("/lib/ld.so.1" "/hurd/exec" + ,(make-arg "device-master-port" exec-server-task device-master))) + (bind "/servers/exec" (resume-translator exec-server-task '())))) + +(define (early-startup) + (let ((startup-control (mach-port-allocate mach-task-self + MACH_PORT_RIGHT_RECEIVE))) (start-handling-early-startup startup-control) (set-active-translator "/servers/startup" 0 0 - (make-send-right startup-control)) - (log "exec ") - (bind "/servers/exec" (resume-translator exec-server-task exec-args)) + (make-send-right startup-control)))) + +(define (second-stage) + (letport + ((proc-task (task-create mach-task-self 0)) + (auth-task (task-create mach-task-self 0))) ;; Starting proc and auth is tricky, we need to do it simultaneously. (let ((pc (bootstrap-proc (start-translator proc-task '("/hurd/proc")))) - (ac (bootstrap-auth (start-translator auth-task '("/hurd/auth"))))) + (ac (bootstrap-auth (start-translator auth-task '("/hurd/auth")))) + ;; Projections for the cookies returned by bootstrap-*. + (:reply car) (:replyPoly cadr) (:server caddr)) (log "proc ") (startup-procinit-reply (:reply pc) (:replyPoly pc) ESUCCESS mach-task-self (:server ac) @@ -159,26 +197,94 @@ ;; Supply the proc server with a standard template. (proc->auth->set-std-execdata! (:server pc) (:server ac)) + ;; Neither the kernel nor our bootscript task have command line + ;; arguments. Fix that. + (frob-task (proc->pid->task (:server pc) 3) + '(gnumach huhu lala XXX)) + (if (mach-port-valid? bootscript-task) + (frob-task bootscript-task '(/hurd/runsystem.scm))) + (frob-task mach-task-self '(/hurd/bootshell)) + (mach-port-deallocate mach-task-self (:server pc)) - (mach-port-deallocate mach-task-self (:server ac)))) + (mach-port-deallocate mach-task-self (:server ac))))) + +(define (run argv) + (letport ((proc (getproc)) + (task (task-create mach-task-self 0)) + (child-proc (proc->task->proc proc task))) + (task-set-name task (car argv)) + (_exec (file-name-lookup (car argv) O_EXEC 0) + task argv MACH_PORT_NULL) + (proc->mark-exec! child-proc) + (proc->mark-important! child-proc) + (proc->task->child! proc task) + (copy-send-right task))) + +(define (start-hurd-console) + (log "hurd-console ") + (throw 'notyet) ;; XXX + (run '(/bin/console + --driver-path=/usr/lib/hurd/console ;; XXX + --driver=current_vcs + --driver=vga + --driver=pc_kbd --keymap us + --driver=pc_mouse --protocol=ps/2 + /dev/vcs)) + + ;; XXX + (symlink 'tty1 '/dev/console) + "/dev/tty1") + +(define (start-mach-console) + (start-active-translator '/dev/console + '(/hurd/term /dev/console device console)) + "/dev/console") - (log "console ") - (bind "/dev/console" - (start-translator (task-create mach-task-self 0) - '("/hurd/term" "/dev/console" "device" "console"))) +(define (start-terminal) + ;; XXX + ;;(start-mach-console) + (let ((device (catch (begin (log "failed: ") + (log last-exception) + (start-mach-console)) + (start-hurd-console)))) + (letport ((term (file-name-lookup device O_RDWR 0))) + (bind-term term)) - (letport ((term (file-name-lookup "/dev/console" O_RDWR 0))) - (bind-term term)) + ;; If we got the Hurd console running, it erased the screen. + (if (string=? device "/dev/tty1") + (begin + (cat "/issue") + (replay-log)))) ;; If we made it this far, we can use libreadline! - (enable-readline) + (enable-readline)) +(define (run-stage stage) + (stage)) + +(define (run-init argv) + (letport ((proc (getproc)) + (task (task-create mach-task-self 0)) + (child-proc (proc->task->proc proc task))) + (proc->task->set-init-task! proc task) + (task-set-name task (car argv)) + + ;; XXX this is roughly what console-run does + ;;(tcsetpgrp 0 (proc->task->pid proc task)) + ;;(proc->setsid! child-proc) + ;;(proc->make-login-coll! child-proc) + + (proc->mark-exec! child-proc) + (proc->mark-important! child-proc) + (proc->task->child! child-proc mach-task-self) + (_exec (file-name-lookup (car argv) O_EXEC 0) + task argv MACH_PORT_NULL) + (copy-send-right task))) + +(define (startup-standalone) ;; The standalone startup server watches essential servers, and ;; handles the system shutdown. - (log "startup ") - (bind "/servers/startup" - (start-translator (task-create mach-task-self 0) - '("/hurd/startup-standalone"))) + (start-active-translator '/servers/startup '(/hurd/startup-standalone)) ;; Now that we have startup, register all servers to it. (letport @@ -193,19 +299,47 @@ (get-essential-tasks)) (map (lambda (c) (startup-request-notification startup (:port c) (:name c))) - (get-registered-tasks)))) - - (log "pflocal ") - (bind "/servers/socket/1" - (start-translator (task-create mach-task-self 0) - '("/hurd/pflocal"))) + (get-registered-tasks))))) +(define (bootstrap stages) + (log "Hurd server bootstrap: ") + (for-each run-stage stages) (log "done.\n")) -(define (boot) +(define (boot!) + (run-init '(/sbin/console-run --console=/dev/console -- /sbin/init -a))) + +(define (boot-demo . args) (catch (panic "Hurd bootstrap failed: " (car last-exception) "\n") - (bootstrap '() '())) + (apply bootstrap args)) + + (shell + (lambda (prefix) + (prompt-append-prefix + (string-append "runsystem@" (hostname) " " (getcwd) " ") prefix)))) + +(define (traditional-boot) + (boot-demo (list traditional-first-stage + early-startup + second-stage + make-essential-devices ;; b/c livecd + start-terminal + startup-standalone + boot!))) + +(define (boot) + (let* ((disks + (filter devprobe? '("hd0s1" "hd1" "hd2" "hd3" "sd0" "sd1" "sd2" "sd3"))) + (rootfs-device (car disks))) + + (echo "Devices discovered: " + (filter devprobe? '("hd0" "hd1" "hd2" "hd3" "sd0" "console" "eth0")) + ". Root device: " rootfs-device ".") - (shell (lambda (prefix) - (prompt-append-prefix - (string-append "runsystem@" (hostname) " " (getcwd) " ") prefix)))) + (boot-demo (list + (lambda () (first-stage rootfs-device)) + early-startup + second-stage + start-terminal + startup-standalone + boot!)))) -- 2.1.4