From de19bb2129c685c98543315485584f8f09a17632 Mon Sep 17 00:00:00 2001 From: Dale Mellor Date: Wed, 19 Aug 2020 15:02:44 +0100 Subject: [PATCH] ibash: extend bash with guile call-outs. Bash is modified to call out to Guile code whenever the user enters a command-line; the code has the opportunity to fix up the command line in any way. The Guile code is under the ibash-scheme directory, all is all newly created in this delta. * configure: why does this have to be in here? * configure.ac: look for guile and libguile. * eval.c: call guile_main and load ~/.bash_guile.scm. * shell.c: perform call-outs prior to executing command lines. * ibash-scheme/ibash-callout.scm: first call-out. * ibash-scheme/remote-sender.scm: second call-out. * ibash-scheme/ibash-server.scm: central intelligence service. * ibash-scheme/modules/i-bash: transform ib -> i-bash. * ibash-scheme/modules/cd: cd command line processor. --- configure | 31 ++++-- configure.ac | 3 + eval.c | 99 ++++++++++++++++++- ibash-scheme/ibash-callout.scm | 61 ++++++++++++ ibash-scheme/ibash-server.scm | 171 +++++++++++++++++++++++++++++++++ ibash-scheme/modules/cd | 71 ++++++++++++++ ibash-scheme/modules/i-bash | 31 ++++++ ibash-scheme/remote-sender.scm | 94 ++++++++++++++++++ shell.c | 48 +++++++-- 9 files changed, 592 insertions(+), 17 deletions(-) create mode 100644 ibash-scheme/ibash-callout.scm create mode 100755 ibash-scheme/ibash-server.scm create mode 100644 ibash-scheme/modules/cd create mode 100644 ibash-scheme/modules/i-bash create mode 100644 ibash-scheme/remote-sender.scm diff --git a/configure b/configure index 60f86d6..e61d33c 100755 --- a/configure +++ b/configure @@ -762,6 +762,7 @@ infodir docdir oldincludedir includedir +runstatedir localstatedir sharedstatedir sysconfdir @@ -891,6 +892,7 @@ datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' @@ -1143,6 +1145,15 @@ do | -silent | --silent | --silen | --sile | --sil) silent=yes ;; + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ @@ -1280,7 +1291,7 @@ fi for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir + libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. @@ -1433,6 +1444,7 @@ Fine tuning of the installation directories: --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] @@ -4702,7 +4714,7 @@ else We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) +#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; @@ -4748,7 +4760,7 @@ else We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) +#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; @@ -4772,7 +4784,7 @@ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) +#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; @@ -4817,7 +4829,7 @@ else We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) +#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; @@ -4841,7 +4853,7 @@ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ -#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) +#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31)) int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]; @@ -4921,6 +4933,9 @@ then CFLAGS="$CFLAGS -Wno-parentheses -Wno-format-security" fi +CFLAGS="${CFLAGS} $(pkg-config guile-2.2 --cflags)" +LDFLAGS="${LDFLAGS} $(pkg-config guile-2.2 --libs)" + if test "$opt_profiling" = "yes"; then PROFILE_FLAGS=-pg case "$host_os" in @@ -7160,6 +7175,8 @@ main () if (*(data + i) != *(data3 + i)) return 14; close (fd); + free (data); + free (data3); return 0; } _ACEOF @@ -11001,6 +11018,8 @@ main () if (*(data + i) != *(data3 + i)) return 14; close (fd); + free (data); + free (data3); return 0; } _ACEOF diff --git a/configure.ac b/configure.ac index ce4e9b6..12dba23 100644 --- a/configure.ac +++ b/configure.ac @@ -467,6 +467,9 @@ then CFLAGS="$CFLAGS -Wno-parentheses -Wno-format-security" fi +CFLAGS="${CFLAGS} $(pkg-config guile-2.2 --cflags)" +LDFLAGS="${LDFLAGS} $(pkg-config guile-2.2 --libs)" + dnl handle options that alter how bash is compiled and linked dnl these must come after the test for cc/gcc if test "$opt_profiling" = "yes"; then diff --git a/eval.c b/eval.c index db863e7..2b12738 100644 --- a/eval.c +++ b/eval.c @@ -47,6 +47,8 @@ # include "bashhist.h" #endif +#include + extern int EOF_reached; extern int indirection_level; extern int posixly_correct; @@ -64,6 +66,20 @@ extern sigset_t top_level_mask; static void send_pwd_to_eterm __P((void)); static sighandler alrm_catcher __P((int)); + +void execute_command_ (COMMAND *c) +{ + /* WORD_LIST *w; */ + + /* for (w = c->value.Simple->words; w; w = w->next) */ + /* { */ + /* printf (" %s :-> %x\n", w->word->word, w->word->flags); */ + /* } */ + + execute_command (c); +} + + /* Read and execute commands until EOF is reached. This assumes that the input source has already been initialized. */ int @@ -177,7 +193,88 @@ reader_loop () free (ps0_string); } - execute_command (current_command); + + + + if (current_command->type != cm_simple) + execute_command (current_command); + + else + { + /* Need to make a SCM array of strings. */ + + WORD_LIST *words; + + SCM a = SCM_EOL; + + for (words = current_command->value.Simple->words; + words; + words = words->next) + a = scm_cons (scm_from_locale_string (words->word->word), + a); + + a = scm_reverse (a); + + + /* !!! Need to check return from scm_c_lookup. */ + SCM x = scm_call_1 + (scm_variable_ref + (scm_c_lookup ("BASH:process-command-line")), + a); + + if (! scm_is_true (x)) + execute_command_ (current_command); + + else + { + for (;;) + { + SCM r = scm_call_0 + (scm_variable_ref + (scm_c_lookup ("BASH:next-command"))); + + if (scm_is_false (r)) + break; + + /* Now we have to compose a new list of words in + * current_command. */ + + for (words = current_command->value.Simple->words; + words;) + { + WORD_LIST *w = words->next; + /* !!! I think there is some sub-structure + * to this which also needs free'ing. */ + free (words); + words = w; + } + + WORD_LIST **words; + + for (words = ¤t_command->value.Simple->words; + ; + ) + { + if (scm_is_null (r)) + break; + + *words = (WORD_LIST*) malloc (sizeof (WORD_LIST)); + + (*words)->next = NULL; + (*words)->word = (WORD_DESC*) malloc (sizeof (WORD_DESC)); + (*words)->word->flags = 0; + + (*words)->word->word = scm_to_locale_string (scm_car (r)); + + r = scm_cdr (r); + + words = &((*words)->next); + } + + execute_command_ (current_command); + } + } + } exec_done: QUIT; diff --git a/ibash-scheme/ibash-callout.scm b/ibash-scheme/ibash-callout.scm new file mode 100644 index 0000000..9e3d45b --- /dev/null +++ b/ibash-scheme/ibash-callout.scm @@ -0,0 +1,61 @@ +;; THE FULL PATH TO THIS FILE SHOULD BE REFERRED TO IN THE ENVIRONMENT +;; VARIABLE "I_BASH_CALLOUT", OR ELSE COPIED TO "$HOME/.bash_guile.scm", +;; FOR EFFECT. + + +;; The functions in this file are called-out to whenever the user enters +;; a command on the ibash command line. + + +;; Copyright (C) 2020 Dale Mellor +;; +;; This file is part of iBash, the intelligent Bourne Again SHell. +;; +;; iBash 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. +;; +;; iBash 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 iBash. If not, see . + + + +(let ((f (getenv "I_BASH_CALLOUT_2"))) + (cond ((and f (access? f R_OK)) (load f)) + (else (let ((f (string-append (getenv "HOME") + "/i-bash/remote-sender.scm"))) + (cond ((access? f R_OK) (load f)) + (else + (display "iBash: ERROR: no call-out-2.\n") + (exit 1))))))) +(use-modules (db core)) +(display "GUILE INITIALIZATION COMPLETE.\n") + + +(define command-stack '()) + +(define (BASH:process-command-line command-words) + (cond ((string=? (car command-words) "db") + (set! command-stack (cons (cdr command-words) command-stack)) + #t) + (else + ;; The process procedure comes from callout-2, loaded above. + (let ((new-stack (process command-words command-stack))) + (cond ((or (not new-stack) + (null? new-stack)) + #f) + (else + (set! command-stack (reverse new-stack)) + #t)))))) + +(define (BASH:next-command) + (cond ((null? command-stack) #f) + (else (let ((hold (car command-stack))) + (set! command-stack (cdr command-stack)) + hold)))) diff --git a/ibash-scheme/ibash-server.scm b/ibash-scheme/ibash-server.scm new file mode 100755 index 0000000..2921a17 --- /dev/null +++ b/ibash-scheme/ibash-server.scm @@ -0,0 +1,171 @@ +#!/usr/bin/guile -s ;; -*-scheme-*- +!# + + +(use-modules (ice-9 regex) (ice-9 popen)) + + + +;; Set up global options, reading from the command-line where possible. + +(define module-dir (string-append (getenv "HOME") "/i-bash/modules")) +(define listen-port 9081) + +(when (> (length (command-line)) 1) (set! module-dir (cadr (command-line)))) + +(when (> (length (command-line)) 2) + (set! listen-port (string->number (caddr (command-line))))) + + + +;; Index the library of modules we have at our disposal for processing +;; command lines. + +(define db-modules '()) +(define verbs '()) +(define word-translators '()) + +;; Let each module in our local file system introduce itself onto the +;; db-modules list above. +(let* ((project-dir (string-append module-dir "/")) + (dir (opendir project-dir))) + (let loop ((file (readdir dir))) + (when (not (eof-object? file)) + (or (eq? #\. (string-ref file 0)) + (eq? #\~ (string-ref file (1- (string-length file)))) + (load (string-append project-dir "/" file))) + (loop (readdir dir))))) + +;; Find the set of verbs and word translations each module provides, +;; and add to the two global lists above. +(for-each (lambda (module) + (let ((v (module-variable (resolve-module module) 'verbs))) + (when v (set! verbs (append! ((variable-ref v)) verbs)))) + (let ((w (module-variable (resolve-module module) + 'word-translators))) + (when w (set! word-translators (append! ((variable-ref w)) + word-translators))))) + db-modules) + + + +;; Run the word-translators over command-words, return pair of new list of +;; command words (translated), and list of used translator s-expressions. + +(define (run-translators-0 command-words) + (let loop-1 ((translators word-translators) + (translator-stack '()) + (words command-words)) + (cond ((null? translators) + (cons words (reverse translator-stack))) + (else + (let ((translator (primitive-eval (car translators)))) + (let loop-2 ((words command-words) + (new-words '()) + (matched #f)) + (cond ((null? words) + (loop-1 (cdr translators) + (append (if matched (list (car translators)) '()) + translator-stack) + (reverse new-words))) + (else + (let ((new-word (translator (car words)))) + (loop-2 (cdr words) + (cons new-word new-words) + (if (string=? new-word (car words)) + matched + #t))))))))))) + + +;; Get the command-words translated and obtain list of used translators, +;; then concoct a new s-expression which will apply the translators again; +;; this is prepended to the incumbent command-stack and returned with the +;; translated command-words. + +(define (run-translators-1 command-words command-stack) + (let* ((res (run-translators-0 command-words)) + (command-words (car res)) + (translator-stack (cdr res))) + (and (not (null? translator-stack)) + (cons command-words + (cons `(lambda (command-words command-stack) + (let loop ((stack (quote ,translator-stack)) + (command-words command-words)) + (cond ((null? stack) + (cons command-words command-stack)) + (else + (let ((tr (primitive-eval (car stack)))) + (let loop-2 ((words command-words) + (ret '())) + (if (null? words) + (loop (cdr stack) (reverse ret)) + (loop-2 (cdr words) + (cons (tr (car words)) + ret))))))))) + command-stack))))) + + + +;; We accept connections, and process intructions, from one client at a +;; time. It is expected that clients will close their connections in a +;; timely manner otherwise the system will hang for everybody using it. + +(let ((socket (socket AF_INET SOCK_STREAM 0))) + (bind socket AF_INET INADDR_LOOPBACK listen-port) + (listen socket 5) + (let socket-listen-loop () + (let ((client (car (accept socket)))) + (let client-command-loop () + (let ((argument (read client))) + (and argument + (not (eof-object? argument)) + (not (null? argument)) + (let* ((command-words (car argument)) + (command-stack '()) ;; We don't care about this on + ;; the server. + (return-stack '()) ;; --This is what we are + ;; interested in building + ;; here. + (run-command + (lambda (command) + (and command + (let ((ret (command command-words command-stack))) + (cond (ret + (set! command-words (car ret)) + (set! command-stack (cdr ret)))) + ret))))) + + (run-command run-translators-1) + (set! return-stack command-stack) + (set! command-stack '()) + + (let loop () + (cond ((not (null? command-words)) + (and (let* ((r- (assoc-ref verbs (car command-words))) + (r (and r- (r- command-words command-stack)))) + (cond ((run-command (primitive-eval r)) + (set! return-stack (cons r return-stack)) + #t) + (else #f))) + (loop))))) + + (if (null? return-stack) + (write '() client) + (write `(lambda (command-words command-stack) + (for-each + (lambda (proc) + (and proc + (let ((ret ((primitive-eval proc) + command-words + command-stack))) + (cond (ret + (set! command-words (car ret)) + (set! command-stack + (cdr ret))))))) + (quote ,(reverse return-stack))) + (cons command-words command-stack)) + client)) + + (client-command-loop)))))) + + (socket-listen-loop))) diff --git a/ibash-scheme/modules/cd b/ibash-scheme/modules/cd new file mode 100644 index 0000000..1a61ab9 --- /dev/null +++ b/ibash-scheme/modules/cd @@ -0,0 +1,71 @@ +;; This file is loaded by ibash-server.scm, and will return a function +;; which intelligently changes a 'cd' command to go directly to a +;; directory under a specially designated set of parent directories. + + +;; Copyright (C) 2020 Dale Mellor +;; +;; This file is part of iBash, the intelligent Bourne Again SHell. +;; +;; iBash 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. +;; +;; iBash 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 iBash. If not, see . + + + +(set! db-modules (cons '(db server cd) db-modules)) + + +(define-module (db server cd) + #:export (verbs)) + + +;; Return an s-exrpression defining a function which returns a list of +;; (absolute) directory paths to search for some given directory. +(define look-list-maker--s '(lambda () + (let ((home (getenv "HOME"))) + (map (lambda (dir) + (string-append home "/" dir)) + '("projects" "documents" ""))))) + + +;; Return an s-expression which evaluates to a function which searches for +;; the requested directory and then modifies the 'cd' command-line +;; (/words/) to go directly to that directory, regardless of the current +;; position in the file system. +;; +;; The return is a cons of remaining /words/ to process, and the modified +;; 'cd' command-line prepended to the existing /stack/ of processed +;; command-lines. +(define (cd words stack) + (cond ((null? (cdr words)) + '(lambda (w s) (cons '() (cons (list "cd") s)))) + (else + `(lambda (words stack) + (if (access? (cadr words) R_OK) + (cons (cddr words) (cons (list "cd" (cadr words)) stack)) + (let loop ((look ((primitive-eval ,look-list-maker--s)))) + (cond ((null? look) + (cons (cddr words) (cons (list "cd" (cadr words)) + stack))) + (else + (let ((dir (string-append (car look) + "/" + (cadr words)))) + (if (access? dir R_OK) + (cons (cddr words) (cons (list "cd" dir) + stack)) + (loop (cdr look)))))))))))) + + +;; Register the above processor with lines beginning with 'cd'. +(define (verbs) (list (cons "cd" cd))) diff --git a/ibash-scheme/modules/i-bash b/ibash-scheme/modules/i-bash new file mode 100644 index 0000000..7a52dd0 --- /dev/null +++ b/ibash-scheme/modules/i-bash @@ -0,0 +1,31 @@ +;; This file is loaded by ibash-server.scm, and will replace any +;; occurrences of the token 'ib' with the token 'i-bash' on the +;; command-line. + + +;; Copyright (C) 2020 Dale Mellor +;; +;; This file is part of iBash, the intelligent Bourne Again SHell. +;; +;; iBash 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. +;; +;; iBash 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 iBash. If not, see . + + + +(set! db-modules (cons '(db i-bash) db-modules)) + +(define-module (db i-bash) + #:export (word-translators)) + +(define (word-translators) + '((lambda (word) (if (string=? word "ib") "i-bash" word)))) diff --git a/ibash-scheme/remote-sender.scm b/ibash-scheme/remote-sender.scm new file mode 100644 index 0000000..e6e4a35 --- /dev/null +++ b/ibash-scheme/remote-sender.scm @@ -0,0 +1,94 @@ +;; THE FULL PATH TO THIS FILE SHOULD BE REFERRED TO IN THE ENVIRONMENT +;; VARIABLE "I_BASH_CALLOUT_2", OR ELSE COPIED TO +;; "$HOME/i-bash/remote-sender.scm", FOR EFFECT. + + +;; The functions in this file are called-out to whenever the user enters +;; a command on the ibash command line. + + +;; Copyright (C) 2020 Dale Mellor +;; +;; This file is part of iBash, the intelligent Bourne Again SHell. +;; +;; iBash 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. +;; +;; iBash 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 iBash. If not, see . + + + +(define-module (db core) + #:use-module (ice-9 popen) + #:export (process)) + + +;; Either return (cons socket action-procedure) or #f. +(define (establish-remote-call) + (let ((connection (getenv "I_BASH_REMOTE"))) + (and connection + (let ((split (string-split connection #\:))) + (cond ((null? (cdr split)) #f) + (else + (catch 'getaddrinfo-error + (lambda () + (let* ((addr (car (getaddrinfo (car split) + (cadr split) 0 AF_INET))) + (socket (socket (addrinfo:fam addr) + (addrinfo:socktype addr) + (addrinfo:protocol addr)))) + (connect socket (addrinfo:addr addr)) + (cons socket + (lambda (command-words command-stack) + (write (cons command-words command-stack) + socket) + (let ((return (read socket))) + (and (not (null? return)) + (eval return (current-module)))))))) + (lambda (key errcode) #f)))))))) + + + +;; The command-words are the tokens of the command line (list of +;; strings), and the command-stack is a list of command lines *in reverse +;; order* which are derived by the intelligence from the originals +;; (command-words). +;; +;; The return value is the updated command-stack, this being ultimately +;; sent back to the bash program and executed as if the new commands had +;; been typed at the terminal. +(define (process command-words command-stack) + (cond ((establish-remote-call) + => (lambda (R) + (let ((server-socket (car R)) + (remote-call (cdr R)) + (run-command (lambda (command) + (and command + (let ((ret (command command-words + command-stack))) + (when ret + (set! command-words (car ret)) + (set! command-stack (cdr ret))) + ret))))) + (let loop () + (unless (null? command-words) + (when (run-command (remote-call command-words + command-stack)) + (loop)))) + (when server-socket (close server-socket))))) + (else + (set! command-words + (string-split + "echo REMOTE iBASH INTELLIGENCE SERVICE NOT AVAILABLE" + #\space)))) + (if (null? command-words) + command-stack + (cons command-words command-stack))) diff --git a/shell.c b/shell.c index 45b77f9..46188b5 100644 --- a/shell.c +++ b/shell.c @@ -89,6 +89,8 @@ extern int get_tty_state __P((void)); # include #endif +#include + #if !defined (HAVE_GETPW_DECLS) extern struct passwd *getpwuid (); #endif /* !HAVE_GETPW_DECLS */ @@ -353,18 +355,13 @@ _cygwin32_check_tmp () } #endif /* __CYGWIN__ */ -#if defined (NO_MAIN_ENV_ARG) -/* systems without third argument to main() */ -int -main (argc, argv) +char **pass_env; + +void +inner_main (closure, argc, argv) + void *closure; int argc; char **argv; -#else /* !NO_MAIN_ENV_ARG */ -int -main (argc, argv, env) - int argc; - char **argv, **env; -#endif /* !NO_MAIN_ENV_ARG */ { register int i; int code, old_errexit_flag; @@ -379,6 +376,8 @@ main (argc, argv, env) env = environ; #endif /* __OPENNT */ + char **env = pass_env; + USE_VAR(argc); USE_VAR(argv); USE_VAR(env); @@ -518,6 +517,17 @@ main (argc, argv, env) } this_command_name = (char *)NULL; + /* Pull in the command-line processor call-out, so that the Guile + command-line processor is available in the Guile universe. */ + scm_c_eval_string + ("(let ((f (getenv \"I_BASH_CALLOUT\"))) " + "(cond ((and f (access? f R_OK)) (load f)) " + "(else (let ((f (string-append (getenv \"HOME\") " + "\"/.bash_guile.scm\"))) " + "(cond ((access? f R_OK) (load f)) " + "(else (display \"iBash: ERROR: no call-out.\n\") " + "(exit 1)))))))"); + /* First, let the outside world know about our interactive status. A shell is interactive if the `-i' flag was given, or if all of the following conditions are met: @@ -793,6 +803,24 @@ main (argc, argv, env) exit_shell (last_command_exit_value); } +#if defined (NO_MAIN_ENV_ARG) +/* systems without third argument to main() */ +int +main (argc, argv) + int argc; + char **argv; +#else /* !NO_MAIN_ENV_ARG */ +int +main (argc, argv, env) + int argc; + char **argv, **env; +#endif /* !NO_MAIN_ENV_ARG */ +{ + pass_env = env; + scm_boot_guile (argc, argv, inner_main, 0); + return 0; /* Never reached. */ +} + static int parse_long_options (argv, arg_start, arg_end) char **argv;