1#!MUNGERPATH 2 3; Mush Copyright (c) 2013 James Bailie. 4; All rights reserved. 5; 6; Redistribution and use in source form, with or without modification, are 7; permitted provided that the following conditions are met: 8; 9; * Redistributions of source code must retain the above copyright 10; notice, this list of conditions and the following disclaimer. 11; * The name of James Bailie may not be used to endorse or promote 12; products derived from this software without specific prior written permission. 13; 14; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" 15; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 17; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 18; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 19; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 20; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 21; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 22; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 23; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 24; POSSIBILITY OF SUCH DAMAGE. 25 26; SYNOPSIS 27; 28; mush [-c <command> | <filename> ] 29 30 31; DESCRIPTION 32; 33; Mush is a job-control shell, written in Munger(1). The shell's command set 34; may be extended with lisp functions. The shell provides features for 35; interactive use, only. Programming is accomplished in the underlying lisp 36; dialect. 37 38 39; START-UP 40 41; The shell attempts to read lisp from the file ~/.mushrc at startup. After 42; ~/.mushrc has been read, the shell attempts to read commands from standard 43; input, unless it has been given command line arguments. 44 45; The shell recognizes one option only, the -c option. If present, it must 46; be followed by a command-line to be run. The shell runs the command and 47; then exits. Note this argument is an actual literal command-line, not a 48; filename of commands to be run. 49 50; Any other command-line arguments are assumed to be filenames to read 51; shell commands from. After all the files have been processed, the shell 52; will then exit. 53 54 55; COMMAND-LINE STRUCTURE, COMMAND AND FILENAME COMPLETION 56 57; The shell gets its input via Munger's 'getline' intrinsic. If stdin is a 58; terminal, command-line editing, command and filename completion, as well as 59; a command history are all available. See the entry for 'getline' in the 60; Munger manual page for full details on how these mechanisms work. 61 62; More than one command may also be entered in one line of input, but only if 63; each command is separated from its neighbors with a space-delimited 64; semi-colon. 65 66; ls ; cd .. 67 68; Output from the shell which is wrapped in square brackets has actually 69; been sent to stderr. Prompts are printed to stdout. 70 71; : cd 72; [ /home/jbailie ] 73 74; The shell recognizes the backslash as a line-continuation character, but 75; only if it is separated from the preceding command-line elements by 76; whitespace. To cancel a command in progress, input a blank line. 77 78; : ls \\ 79; : *cgi 80; blog.cgi 81; client.cgi 82; login.cgi 83 84 85; GLOBBING 86 87; Shell glob patterns in unquoted command arguments will be recognized and 88; substituted apropriately. The command position never undergoes 89; glob-expansion. 90 91 92; QUOTING 93 94; There is only one quoting mechanism, the double-quote: "quoted element". 95 96; Single command-line tokens which contain whitespace must be quoted to be 97; recognized by the shell as single tokens. 98 99; Quoting suppresses glob and alias expansion. 100 101; Quoting the tokens '\\', '&', '|', ';', '>', '>>', '2>', and '2>>' causes 102; the shell to treat them as literal values, and not shell instructions. 103 104; Munger's command and filename completion mechanism will work with commands 105; and filenames containing whitespace, but will not quote these 106; items. The user must quote these items manually. 107 108; To embed literal quotes in the command line, whether or not they are part 109; of quoted elements, each individual " must be escaped with a backslash. 110 111; : echo \\"foobar\\" 112; "foobar" 113; : echo "embedded whitespace and quotes: \\"foobar\\"" 114; embedded whitespace and quotes: "foobar" 115 116 117; JOB CONTROL 118 119; A process may be started in the background by passing a last command 120; line element consisting of the ampersand character '&'. It must be 121; separated from the command arguments by whitespace in order for it to be 122; recognized by the shell. 123 124; A user may stop a foreground process group by pressing Control-Z. The 125; stopped process group may be restarted in the foreground by invoking 'fg'. 126; The process group may be restarted in the background by invoking 'bg'. 127 128; An invocation of 'fg' or 'bg' without an argument will restart the most 129; recently stopped process. 130 131; If that process exits, then another invocation of 'fg' or 'bg' without 132; argument will start the next most recently stopped process. 133 134; If there are no stopped processes, but there are background processes, then 135; 'fg' without argument will foreground the most recently-backgrounded 136; process. 137 138; 'fg' may be invoked with a single argument, which must be the process group 139; id of a stopped or backgrounded process group to be started in the 140; foreground. 141 142; 'bg' may be invoked with a single argument, which must be the process group 143; id of a stopped process group to be started in the background. 144 145; The pgids of stopped and background processes may be ascertained with 146; the 'jobs' command. If the output from 'jobs' is longer than the height 147; of the screen, stderr may be redirected to file. 148 149; If the user attempts to exit the shell with Control-D when there are 150; stopped jobs, the shell will complain. Invoking 'exit' will cause 151; the shell to exit unconditionally. 152 153 154; REDIRECTIONS 155 156; The last command line arguments (before the '&' if it is present on the 157; command-line), may be redirection instructions. Redirection instructions 158; consist of a redirection symbol followed by a filename. The filename must 159; be separated from the symbol by whitespace. Redirection symbols are one of 160; '>', '>>', '2>', '2>>', or '<'. 161 162; > filename 163 164; instructs the shell to redirect the standard output of the associated 165; command to the specified file. 166 167; >> filename 168 169; works similarly, but indicates the file should be opened in append mode. 170 171; 2> filename 172 173; instructs the shell to redirect the standard error of the associated 174; command to the specfied file. 175 176; 2>> filename 177 178; works similarly, but indicates the file should be opened in append mode. 179 180; < filename 181 182; Instructs the shell to redirect the standard input of the associated 183; command to the specified file. 184 185; Glob patterns are not recognized in redirection instruction filenames 186; whether or not they are quoted, but they are subject to quote processing 187; and environment variable interpolation. In other words an unquoted 188; filename argument behaves as if it were quoted. There are four special 189; cases where the filename is interpreted as a file descriptor: 190 191; > 2 192 193; means stdout is to be redirected onto stderr. 194 195; >> 2 196 197; equivalent to the above. 198 199; 2> 1 200 201; means stderr is to be redirected onto stdout. 202 203; 2>> 1 204 205; equivalent to the above. 206 207; If one wishes to redirect to a file named '1' or '2' then one must 208; qualify the filename. Note that redirection instructions must be 209; contiguous tokens of non-whitespace characters. These two commands are not 210; equivalent: 211 212; : program 2> filename 213; : program 2 > filename 214 215; The first command runs 'program' with no arguments and stderr redirected 216; to 'filename', while the second command runs 'program' with one argument 217; named 2, and with stdout redirected to 'filename'. 218 219; The shell redirects stdout before redirecting stderr, regardless of the 220; order in which the redirections occurred on the command line. So, if you 221; wish to redirect stdout and stderr onto the same file, both of the 222; following commands will do it: 223 224; cat > filename 2> 1 225; cat 2> 1 > filename 226 227; This command will not do it: 228 229; cat 2> filename > 2 230 231; The shell would redirect stdout onto stderr first, and then redirect stderr 232; onto the file. This means stdout would remain redirected to the original 233; stderr stream. It also means the only real use of > 2 is to send stdout to 234; the original stderr stream. 235 236 237; PIPELINES 238 239; To create a pipeline each command in the pipeline must be separated from 240; its neighbor with a '|', itself separated from its neighbors by whitespace. 241 242; Note that redirections for each process in the pipeline may be specified 243; before the |, but that only stderr redirections will be attempted, except 244; for the first process in the pipeline, where stdin redirection will be 245; attempted as well, and the last process, where only stdout and stderr 246; redirections will be attempted. 247 248; : jot 100 | fmt | grep 100 249; 92 93 94 95 96 97 98 99 100 250 251; If the commands in a pipeline are long, one can break up the pipeline and 252; input each command on a separate line. To do this, all the commands, 253; excepting the last, must have the '|' character as their last element. The 254; shell will continue to prompt for more commands until one is entered which 255; does not end with '|'. 256 257; : jot 100 | 258; : fmt | 259; : grep 100 260; 92 93 94 95 96 97 98 99 100 261 262; To cancel a pipeline line in progress, enter a blank line. 263 264; A pipeline can be started in the background, in the same manner as an 265; ordinary command: 266 267; : jot 100 | fmt | grep 100 & 268 269; This particular pipeline would receive SIGTTOU, stopping it, as soon as 270; grep attempted to print to the terminal. 271 272 273; ALIASES 274 275; Abbreviations may be defined which will be recognized and expanded where 276; the abbreviation text is unquoted and delimited by whitespace. The 'alias' 277; and 'unalias' define and undefine, respectively, aliases. The alias 278; command accepts two or more arguments, the first of which is the 279; abbreviation, while the rest form the expansion. 280 281; alias ll ls -l 282; [ ll => ls -l ] 283; alias lf ls -F 284; [ lf => ls -F ] 285 286; The aliases command lists the currently defined aliases. 287 288; aliases 289; [ ll => ls -l ] 290; [ lf => ls -F ] 291 292; To define aliases in the user's ~/.mushrc, abbreviations are mapped to 293; lists of tokens in the aliases table. 294 295; (hash aliases "ll" '("ls" "-l")) 296; (hash aliases "lf" '("ls" "-F")) 297; (hash aliases "ff" '("firefox" ">" "/dev/null" "2>" "1" "&")) 298; (hash aliases "sl" '("sylpheed" ">" "/dev/null" "2>" "1" "&")) 299 300; One feature I did not implement is subshell command interpolation where a 301; backtick-delimited command is run in a subshell, and its output 302; is interpolated into the command line. You can use a stdin redirection 303; or a pipe to xargs -I or -J to accomplish similar tasks. 304 305; xargs -J % kill -TERM % < /var/run/httpd.pid 306; cat /var/run/syslog.pid /var/run/sendmail.pid | xargs -J % kill -HUP % 307 308 309; CHANGING DIRECTORIES 310 311; The shell has an internal 'cd' command to change the current working 312; directory. Invoked without arguments, it will make the user's home 313; directory the current working directory. Invoked with '-' as argument, it 314; will attempt to change to the directory which was the previous current 315; working directory before the last invocation of 'cd' . If the argument to 316; 'cd' is unquoted it undergoes glob-expansion. If the glob-expansion 317; produces more than one result, the first is used. 318 319 320; MODIFYING THE PROMPT 321 322; The user may change the string used as the command prompt with the 323; 'prompt' shell command. Environment variable interpolation, 324; quote-processing, and glob-expansion are performed on the argument. If the 325; user provides more than one argument, or glob-expansion results in more 326; than one argument, the first is used. 327 328; : prompt "$ " 329; $ 330 331; The user may change the prompt in their ~/.mushrc by assigning a string to 332; the 'prompt' global. 333 334 335; MODIFYING PATH 336 337; If the user changes the PATH environment variable or adds executables to 338; the directories specified by the variable, then he or she must invoke the 339; shell's 'rescan' command in order to get the Munger interpreter to update 340; its internal list of executables. 341 342 343; EXEC-ING NEW PROCESS IMAGES 344 345; The shell has an 'exec' command to replace itself with a new process image. 346; Any command preceded by 'exec' on the command line replaces the shell, so 347; that when the command exits, one will be dumped back to where one was 348; before the shell started, which may be the login prompt. 349 350 351; PROGRAMMING 352 353; Entering a lone '.' in the command position will cause the shell to drop 354; down to a Munger interpreter prompt where lisp may be evaluated. Control-D 355; or '_' exits back to the shell. 356 357 358; INITIALIZING THE ENVIRONMENT 359 360; Lisp may be inserted into ~.mushrc to be executed at start-up to define 361; environment variables and user-functions. 362 363; (setenv "CLICOLOR" "1") 364; (setenv "EDITOR" "dkns") 365; (setenv "PAGER" "more") 366; (setenv "BLOCKSIZE" "K") 367; (setenv "PATH" "/usr/local/bin:/usr/bin:/bin/:/sbin:/usr/sbin") 368; (setenv "HOME" "/home/jbailie/") 369 370 371; USER-DEFINED FUNCTIONS 372 373; When the shell is processing commands, any item in command position, which 374; is not recognized as an executable or shell command, is looked-up in the 375; 'functions' table. This table maps command name strings to closures. A 376; lisp function inserted into the functions table must be defined to accept a 377; variable length argument list. If a lisp function encounters an error the 378; shell will exit, perhaps terminating your login, so user functions should 379; be well-tested. User functions may be defined at the lisp prompt or 380; specified in ~/.mushrc 381 382; The 'cd', 'expand_items', and 'fork_it' helper functions are exposed for 383; use by user code. The 'functions' and 'aliases' tables, the 'pipecmds' 384; list, the 'last_status' variable, and the 'prompt' string are also 385; available. 386 387; Note that the only items given to the lisp function are the command's 388; arguments, after variable and subshell interpolation and alias expansion 389; have been performed. Redirection instructions, and '&' and '|' will all 390; have been stripped away. Glob expansion and quote processing WILL NOT have 391; been performed on the arguments. 392 393; In the following example, the 'fork_it' function performs glob-expansion 394; and escape removal for us. This allows user functions to create argument 395; lists for 'fork_it' using glob patterns, and also to quote literal items 396; resembling glob patterns to prevent expansion. 'fork_it' will also perform 397; any redirections which were specified on the command line. 398 399; (hash functions 400; "up" 401; (let ((cmd (command_lookup "scp"))) 402; (lambda ((args)) 403; (fork_it 0 404; cmd 405; (append args (list "root@mammothcheese.ca:/usr/local/www/html/")))))) 406 407; The first argument to 'fork_it' is a boolean indicating whether or not the 408; process should be run in the background. Here, 0 indicates it will be run 409; in the foreground. The second argument is the fully-qualified path to the 410; command to be run. We use the 'command_lookup' intrinsic to find the 411; location of 'scp' for us. The third argument is a list of the arguments to 412; be passed to the command. We simply append another argument to the ones 413; the user has supplied to complete the 'scp' command. 414 415; After this definition has been evaluated, this shell command: 416 417; : up *.html 418 419; will be equivalent to this shell command: 420 421; : scp *.html root@mammothcheese.ca:/usr/local/www/html/ 422 423; The 'fork_it' function returns the exit status of the command if it exited, 424; or it returns the signal number that either killed or stopped the process. 425 426; The function has another use, triggered by the presence of an optional 427; fourth argument. If present, the fourth argument, regardless of its value, 428; indicates that 'fork_it' should impose a pipe between itself and the 429; command, and gather up the command's output and return it as a single 430; string, instead of returning the exit status/signal number. Note that when 431; the fourth argument is present, 'fork_it' will ignore the first argument, 432; and always run the command in the background so that job control signals 433; cannot stop the command while 'fork_it' is gathering up the command's 434; output. 435 436; (fork_it 0 (command_lookup "ls") '("*munger") 1) 437; "cal.munger 438; cat.munger 439; cgi.munger 440; dkns.munger 441; ed.munger 442; err.munger 443; fcgi.munger 444; filter.munger 445; fmt.munger 446; google.munger 447; grep.munger 448; incorporation.munger 449; library.munger 450; mbox2munger.munger 451; mime2munger.munger 452; msh.munger 453; options.munger 454; rss.munger 455; tags.munger 456; tk.munger 457; transform.munger 458; view.munger 459; xml2alist.munger 460; xml2sqlite.munger 461; xmlquery.munger 462; xmlsqlite.munger 463; " 464 465; The 'last_status' global contains the exit status of the last command run 466; in the foreground, or the signal number of the signal which killed/ stopped 467; it. Here is a user-function which makes use of it: 468 469; (hash functions 470; "and" 471; (let ((cmd "")) 472 473; (lambda ((args)) 474; (when args 475 476; (unless last_status 477; (setq cmd (substring (car args) 0 1)) 478 479; (if (or (eq "." cmd) (eq "/" cmd)) 480; (setq cmd (car args)) 481; (setq cmd (command_lookup (car args)))) 482 483; (fork_it 0 cmd (cdr args))))))) 484 485; One could use this function when compiling: 486 487; : make ; and make install 488 489; This function will expose the value of last_status to the user: 490 491; (hash functions 492; "status" 493; (lambda ((ignored)) 494; (warn "[ " last_status " ]"))) 495 496; The 'cd' utility function accepts a string specifying the directory to 497; change to or a false boolean ("", (), or 0), which means to change to the 498; user's home directory. If the string is '-' the function works just like 499; invoking 'cd -' at the command prompt, as described earlier in this 500; comment. 501 502; The 'expand_items' utility function accepts the argument list passed to the 503; lisp function and returns a new list with each of the items processed 504; appropriately for quotes and glob-expansion. Note that 'fork_it' calls 505; this function itself. It is provided for use in situations where the 506; user-function does not call 'fork_it'. 507 508; Here is a custom "detab" function to expand tabs in a set of files to a 509; maximum of 3 spaces: 510 511; (hash functions 512; "detab" 513 514; (let ((tmp "") (line "")) 515 516; (lambda ((args)) 517; (setq args (expand_items args)) 518 519; (while args 520; (with_output_file (setq tmp (concat (car args) ".tmp")) 521; (with_input_file (car args) 522; (while (setq line (getline)) 523; (print (expand 3 line))))) 524 525; (rename tmp (car args)) 526; (setq args (cdr args)))))) 527 528; This user-function rips an audio cd into .mp3 files. The input device is 529; specified as argument. 530 531; (hash functions 532; "ripit" 533 534; (let ((conv (command_lookup "dagrab")) 535; (lame (command_lookup "lame"))) 536 537; (lambda ((args)) 538; (if (not args) 539; (warn "[ DEVICE NAME REQUIRED ]") 540 541; (fork_it 0 conv (cons "-a" (cons "-d" args))) 542; (foreach 543; (lambda (x) 544; (fork_it 0 lame (list x (concat (rootname x) ".mp3")))) 545; (glob "*.wav")))))) 546 547; It would be invoked like this: 548 549; : ripit /dev/acd0 550 551; Here is a user-function which provides functionality similar to a "here" 552; document in other shells. It accepts an end token preceding a command 553; line, as arguments. It then reads lines of text from the terminal until it 554; encounters a line consisting of just the end token, which it discards. The 555; collected lines are written to a temporary file, and then the specified 556; command line is run with its standard input redirected onto the temporary 557; file. After the command terminates, the temporary file is deleted. 558 559; (hash functions 560; "collect" 561; (lambda ((args)) 562 563; (let ((tmp "") 564; (file "") 565; (tst "") 566; (here (stack))) 567 568; (if (< (length args) 2) 569; (warn "[ USAGE: collect <end> <cmd> <arg>* ]") 570 571; (until (eq (car args) (if (setq tmp (getline "collect: " 8)) 572; (setq tmp (chomp tmp)) 573; "")) 574; (push here tmp)) 575 576; (setq file 577; (with_temporary_output_file 578; (foreach println (flatten here)))) 579 580; (setq args (cdr args)) 581; (setq cmd (substring (car args) 0 1)) 582 583; (if (or (eq "." cmd) (eq "/" cmd)) 584; (setq cmd (car args)) 585; (setq cmd (command_lookup (car args)))) 586 587; (protect 588; (with_input_file file 589; (fork_it 0 cmd (cdr args))) 590 591; (unlink file)) 592 593; (clear here (used here)))))) 594 595; User functions do not participate in pipelines described on the 596; command-line, but user functions may create pipelines. The programmer 597; places lists of items describing each command onto the 'pipecmds' list in 598; reverse order, for all but the last command in the pipeline. The 599; programmer then invokes \'fork_it' on the last command. Each sublist in 600; the 'pipecmds' list consists of four elements. 601 602; First, a boolean false ("", (), or 0), or a two-element list consisting of 603; a filename onto which to redirect standard error, and a boolean indicating 604; whether or not to open the file in append mode. 605 606; Second, the fully-qualified path to the command. 607 608; Third, a list of the command's arguments as they would appear before 609; quote-processing and glob expansion. Environment variable and subshell 610; interpolation, and alias expansion will not be performed on these items. 611 612; Fourth, a false boolean, or a filename to redirect stdin onto. 613 614; Any command in the pipeline may specify a stderr redirection, but only the 615; first command in the pipeline (but last on the list) should specify a stdin 616; redirection. If you include a stdin redirection for other processes in the 617; pipeline, you will break the pipeline. Output redirections for the last 618; process in the pipeline can be specified on the command line when the user 619; function is invoked. The example below is the equivalent of 620; ls | fmt -l 35 | grep -n foobar. 621 622; (hash functions 623; "myfunc" 624 625; (let ((ls (command_lookup "ls")) 626; (fmt (command_lookup "fmt")) 627; (grep (command_lookup "grep"))) 628 629; (lambda ((args)) 630; (setq pipecmds (qquote '((0 ,fmt ("-l" "35") 0) 631; (0 ,ls () 0)))) 632 633; (fork_it 0 grep '("-n" "foobar"))))) 634 635; If the pipeline did not print to the terminal, we could have given a first 636; argument of 1 to 'fork_it' to cause the pipeline to be run in the 637; background. 638 639; ----------------------------------------------------------------------- 640 641; Program text. 642 643(fatal) 644 645; Blocks SIGHUP, SIGINT, SIGQUIT, SIGTTOU, SIGTTIN, and SIGTSTP. 646; It is particularly necessary for us to block SIGTTOU or the shell will 647; not be allowed to invoke "tcsetpgrp" when it is a background process, 648; preventing job control from working. 649 650(block) 651 652; This stops the interpreter from reaping zombies, so the shell can know 653; when processes change state. 654 655(zombies) 656 657; This table maps strings to closures. Each string names a user-function 658; and is mapped to the closure implementing the user-function. 659 660(setq functions (table)) 661 662; This table maps strings to lists defining aliases. 663 664(setq aliases (table)) 665 666; The initial string used for the prompt. 667 668(setq prompt (concat (car (geteuid)) ": ")) 669 670; A list to contain the items in a pipeline. 671 672(setq pipecmds ()) 673 674; Holds the exit status of the last command run in the foreground, 675; or the signal number which killed/stopped it. 676 677(setq last_status 0) 678 679; Get the saved command line history, if any. 680 681(load_history (join "/" (getenv "HOME") ".mush_history")) 682 683; The whole program is wrapped in a closure to create a namespace 684; unavailable to the user when he or she is working at the lisp prompt 685; via "interact". 686 687; This prevents the user from inadventently changing the shell program 688; itself. 689 690(let ((stopped ()) (background ()) (names (table)) 691 (remove_quotes 0) (do_alias 0) (do_unalias 0) 692 (do_exec 0) (do_prompt 0) (do_jobs 0) 693 (expand_alias 0) (main 0) (do_aliases 0) 694 (wait_for_bg 0) (wait_for_it 0) (fg 0) 695 (bg 0) (get_redirections 0) (get_redir0 0) 696 (get_redir1 0) (get_redir2 0) (do_redirections 0) 697 (escape 0) (remove_slash 0) (spawn_pipeline 0) 698 (check_cmd 0) (process_command 0) (try_it 0) 699 (quote_rx (regcomp "\""))) 700 701 702; This function blocks in "wait" until the specified process stops or 703; exits. We call it after starting a foreground process to reap its 704; zombie or report it to the user as stopped. 705 706(defun wait_for_it (pid) 707 (setq pid (wait pid)) 708 (tcsetpgrp (getpgrp)) 709 710 (when (eq 'STOPPED (cadr pid)) 711 (setq stopped (cons (car pid) stopped)) 712 (warn "") 713 (warn "[ PROCESS GROUP " (car pid) " " (cadr pid) "; SIGNAL " (caddr pid) " ]")) 714 715 (when (eq 'KILLED (cadr pid)) 716 (unhash names (car pid))) 717 718 (caddr pid)) 719 720; This function is called once for each iteration of the command-processing 721; loop to reap the zombies of any exited background processes, and to 722; report the status of any stopped background processes. The items on the 723; background list are all process group ids. 724 725(defun wait_for_bg ((pid)) 726 (setq background 727 (remove 0 728 (mapcar 729 (lambda (x) 730 (cond ((eq -1 (car (setq pid (wait x 1)))) 0) 731 732 ((not (car pid)) x) 733 734 (1 (when (eq 'STOPPED (cadr pid)) 735 (setq stopped (cons (car pid) stopped))) 736 (warn "[ BACKGROUND PROCESS GROUP " (car pid) " " 737 (cadr pid) "; STATUS/SIGNAL " (caddr pid) " ]") 738 (unhash names (car pid)) 739 0))) 740 741 background))) 742 743 ; Pick up any zombies from pipeline processes other than the process 744 ; group leader. 745 746 (while (> (car (wait -1 1)) 0) 747 (unhash names (car pid)))) 748 749; Function to foreground the most recent stopped or backgrounded process. 750 751(defun fg ((pid)) 752 753 (if (not pid) 754 (if (not stopped) 755 (if (not background) 756 (warn "[ NO STOPPED OR BACKGROUND PROCESS GROUPS ]") 757 758 (setq pid (car background)) 759 (setq background (cdr background))) 760 761 (setq pid (car stopped)) 762 (setq stopped (cdr stopped)) 763 (setq background (remove pid background))) 764 765 (setq pid (digitize (car pid))) 766 (if (not (or (member pid stopped) 767 (member pid background))) 768 (progn 769 (warn "[ NO STOPPED OR BACKGROUNDED PROCESS GROUP WITH PGID " pid " ]") 770 (setq pid 0)) 771 772 (setq stopped (remove pid stopped)) 773 (setq background (remove pid background)))) 774 775 (when pid 776 (tcsetpgrp pid) 777 (killpg pid 19) 778 (wait_for_it pid))) 779 780; Function to background the most recently-stopped process. 781 782(defun bg ((pid)) 783 (if (not stopped) 784 (warn "[ NO STOPPED PROCESS GROUPS ]") 785 786 (if pid 787 (if (not (member (setq pid (digitize (car pid))) stopped)) 788 (warn "[ NO STOPPED PROCESS GROUP WITH PGID " pid " ]") 789 790 (setq stopped (remove pid stopped))) 791 792 (setq pid (car stopped)) 793 (setq stopped (cdr stopped))) 794 795 (setq background (cons pid background)) 796 (killpg pid 19))) 797 798; Function to ensure that the command specified on the command line 799; exists, before we attempt to "fork_it". 800 801(defun check_cmd (item (tmp)) 802 (if (or (eq "." (setq tmp (substring item 0 1))) 803 (eq "/" tmp)) 804 805 (when (and (eq (exists item) 1) 806 (access item 0) 807 (access item 2)) 808 item) 809 810 (command_lookup item))) 811 812; Group of functions to parse redirection instructions from the command 813; line and store them, and to perform the redirections at a later time. 814 815(let ((redir_rx (regcomp "^(2?)(>>?)$")) 816 (m ()) (redir0 0) (redir1 0) (redir2 0) 817 (tmp 0) (redir "") (file "") (app 0)) 818 819 (defun get_redirections (items) 820 (setq redir0 (setq redir1 (setq redir2 0))) 821 822 (catch 823 (while (>= (length items) 3) 824 (setq file (car items)) 825 (setq redir (cadr items)) 826 827 (cond ((setq m (matches redir_rx redir)) 828 (setq app (if (eq (caddr m) ">") 0 1)) 829 (if (not (cadr m)) 830 (setq redir1 (list (escape file) app)) 831 (setq redir2 (list (escape file) app)))) 832 833 ((eq redir "<") (setq redir0 (escape file))) 834 835 (1 (throw items))) 836 837 (setq items (cddr items))) 838 839 items)) 840 841 (defun get_redir0 () redir0) 842 (defun get_redir1 () redir1) 843 (defun get_redir2 () redir2) 844 845 (defun try_it (desc file app) 846 (setq tmp (exists file)) 847 848 (cond ((and (not desc) (not tmp)) 849 (beep) 850 (warn "[ " file " DOES NOT EXIST ]")) 851 852 ((and (or (not desc) (and desc app tmp)) 853 (or (eq tmp 2) (eq tmp 3) (eq tmp 4) (eq tmp 8))) 854 (beep) 855 (warn "[ " file " IS NOT A FILE, FIFO, SYMLINK, OR SOCKET ]")) 856 857 ((stringp (setq tmp (if desc (redirect desc file app) (redirect 0 file)))) 858 (beep) 859 (warn "[ " file ": " tmp " ]")) 860 861 ((< tmp 0) 862 (beep) 863 (warn "[ " file ": " (case tmp (-1 "DOES NOT EXIST") 864 (-2 "PERMISSION DENIED") 865 (-3 "LOCKED")) " ]")))) 866 867 (defun do_redirections () 868 (catch 869 (when redir0 870 (when (try_it 0 redir0 0) 871 (throw 0))) 872 873 (when redir1 874 (if (eq "2" (car redir1)) 875 (stdout2stderr) 876 (when (try_it 1 (car redir1) (cadr redir1)) 877 (throw 0)))) 878 879 (when redir2 880 (if (eq "1" (car redir2)) 881 (stderr2stdout) 882 (when (try_it 2 (car redir2) (cadr redir2)) 883 (throw 0)))) 884 885 1))) 886 887; Closure provides some regexps and temporary variables to 888; a group of functions. 889 890(let ((delim_rx (regcomp "^\"(.*)\"$")) 891 (quote_rx (regcomp "\\\\\"")) 892 (glob_rx (regcomp "[]~[{}*?]")) 893 (slash_rx (regcomp "/$")) 894 (old_dir "") 895 (tmp "") 896 (tmp2 "") 897 (tmp3 "")) 898 899 ; Strips delimiter quotes from quoted items, and unescapes escaped 900 ; quotes in both quoted and unquoted items. 901 902 (defun escape (str) 903 (substitute quote_rx "\"" 904 (substitute delim_rx "\1" str) 0)) 905 906 ; Implements the "cd" shell command. 907 908 (defun cd (dir) 909 (when dir 910 (if (match delim_rx (setq tmp dir)) 911 (setq tmp3 (escape tmp)) 912 (setq tmp3 (substitute quote_rx "\"" tmp 0)) 913 914 (when (setq tmp (glob tmp3)) 915 (setq tmp3 (car tmp))))) 916 917 (cond ((not dir) 918 (setq tmp3 (pwd)) 919 (if (stringp (setq tmp (chdir (setq tmp2 (getenv "HOME"))))) 920 (warn "[ " (upcase tmp 1) " ]") 921 (setq old_dir tmp3) 922 (warn "[ " tmp2 " ]"))) 923 924 ((eq "-" tmp3) 925 (if (not old_dir) 926 (warn "[ NO PREVIOUS DIRECTORY ]") 927 928 (setq tmp2 (pwd)) 929 (if (stringp (setq tmp (chdir old_dir))) 930 (warn "[ " (upcase tmp 1) " ]") 931 932 (warn "[ " old_dir " ]") 933 (setq old_dir tmp2)))) 934 935 ((and (setq tmp2 (pwd)) (stringp (setq tmp (chdir tmp3)))) 936 (warn "[ " (upcase tmp 1) " ]")) 937 938 (1 (setq old_dir tmp2) 939 (warn "[ " (pwd) " ]")))) 940 941 ; Removes trailing slash from glob-expanded items which are 942 ; directories, so command like this work as expected: 943 944 ; : ls | grep *munger 945 946 (defun remove_slash (item) 947 (substitute slash_rx "" item)) 948 949 ; Remove delimiting quotes from argument. 950 951 (defun remove_quotes (item) 952 (substitute delim_rx "\1" item 1)) 953 954 ; Performs quote-processing and glob-expansion over an 955 ; entire argument list. 956 957 (defun expand_items (items) 958 (setq tmp items) 959 (setq items ()) 960 961 (while tmp 962 (if (match delim_rx (car tmp)) 963 (setq items (cons (escape (car tmp)) items)) 964 965 (setq tmp3 (substitute quote_rx "\"" (car tmp) 0)) 966 967 (if (and (match glob_rx tmp3) (setq tmp2 (glob tmp3))) 968 (setq items (append (mapcar remove_slash tmp2) items)) 969 (setq items (cons tmp3 items)))) 970 971 (setq tmp (cdr tmp))) 972 973 (reverse items)) 974 975 ; Function to spawn a pipeline off of the stdin of a child process 976 ; created by "fork_it". Does any pending redirections for each process 977 ; along the way. The "fork_it" child is the process group leader, and 978 ; the last element in the pipeline. 979 980 (defun spawn_pipeline (cmd items (pid)) 981 (setq pipecmds (reverse pipecmds)) 982 983 (while pipecmds 984 (setq tmp3 (expand_items (caddr (car pipecmds)))) 985 (setq tmp (car pipecmds)) 986 987 (case (setq pid (forkpipe 0)) 988 (-1 (warn "[ COULD NOT FORK ]")) 989 990 (0 (when (setq tmp2 (cadddr tmp)) 991 (try_it 0 tmp2 0)) 992 993 (when (setq tmp2 (car tmp)) 994 (if (eq "1" (car tmp2)) 995 (stderr2stdout) 996 (try_it 2 (car tmp2) (cadr tmp2)))) 997 998 (when (stringp (cadr tmp)) 999 (apply exec (cons (cadr tmp) tmp3))) 1000 (exit 1))) 1001 1002 (setq pipecmds (cdr pipecmds))) 1003 1004 (when (setq tmp (get_redir1)) 1005 (if (eq "2" (car tmp)) 1006 (stdout2stderr) 1007 (try_it 1 (car tmp) (cadr tmp)))) 1008 1009 (when (setq tmp (get_redir2)) 1010 (if (eq "1" (car tmp)) 1011 (stderr2stdout) 1012 (try_it 2 (car tmp) (cadr tmp)))) 1013 1014 (apply exec (cons cmd items)) 1015 (exit 1))) 1016 1017; Function to fork a new process, and establish new process group. 1018; Causes redirections to be performed, and pipelines to be spawned. 1019 1020(let ((gc 0) (pid 0) (str "") (line "")) 1021 1022 (defun fork_it (start_bg cmd items (flag)) 1023 (setq items (expand_items items)) 1024 1025 ; Turn-off garbage collection during process creation, to 1026 ; make it happen faster. 1027 1028 (setq gc (gc_freq 0)) 1029 1030 (case (setq pid (if flag (forkpipe 0) (fork))) 1031 (-1 (warn "[ COULD NOT FORK ]") (gc_freq gc)) 1032 1033 (0 (setpgid 0 0) 1034 (unless (or start_bg flag) 1035 (tcsetpgrp (getpgrp))) 1036 (unblock) 1037 1038 (if pipecmds 1039 (spawn_pipeline cmd items) 1040 (when (do_redirections) 1041 (apply exec (cons cmd items))) 1042 (exit 1))) 1043 1044 (? (setpgid pid pid) 1045 (gc_freq gc) 1046 (hash names pid cmd) 1047 1048 (if start_bg 1049 (setq background (cons pid background)) 1050 1051 (if (not flag) 1052 (progn 1053 (tcsetpgrp pid) 1054 (setq last_status (wait_for_it pid))) 1055 1056 (setq str "") 1057 (while (setq line (getline)) 1058 (setq str (concat str line))) 1059 (resume 0) 1060 (canon) 1061 (setq last_status (wait_for_it pid)) 1062 str)))))) 1063 1064; Function to implement the "exec" shell command. 1065 1066(let ((c "")) 1067 1068 (defun do_exec (items) 1069 (when items 1070 (setq c (substring (car items) 0 1)) 1071 (apply exec (cons (if (or (eq c "/") (eq c ".")) 1072 (car items) 1073 (command_lookup (car items))) 1074 (expand_items (cdr items))))))) 1075 1076; Function to change the command prompt. 1077 1078(defun do_prompt (items) 1079 (if (not items) 1080 (warn "[ PROMPT STRING MUST BE PROVIDED ]") 1081 (setq prompt (car (expand_items items))))) 1082 1083; Function to display jobs running in the background. 1084 1085(defun do_jobs () 1086 (do_redirections) 1087 1088 (warn "[ BACKGROUND JOBS: " (length background) " ]") 1089 (foreach 1090 (lambda (pid) (warn "[ " pid ": " (lookup names pid) " ]")) 1091 background) 1092 1093 (warn "[ STOPPED JOBS: " (length stopped) " ]") 1094 (foreach 1095 (lambda (pid) (warn "[ " pid ": " (lookup names pid) " ]")) 1096 stopped)) 1097 1098; Functions to manage aliases. 1099 1100(let ((k ())) 1101 (defun do_aliases () 1102 (if (not (setq k (keys aliases))) 1103 (warn "[ NO ALIASES DEFINED ]") 1104 1105 (foreach 1106 (lambda (k) 1107 (warn "[ " k " => " (join " " (lookup aliases k)) " ]")) 1108 k)))) 1109 1110(defun do_alias (args) 1111 (if (< (length args) 2) 1112 (warn "[ USAGE: alias <alias> <token>+ ]") 1113 1114 (if (match quote_rx (car args)) 1115 (warn "[ ALIASES CANNOT CONTAIN QUOTE CHARACTERS ]") 1116 1117 (hash aliases (car args) (cdr args)) 1118 (warn "[ " (car args) " => " (join " " (cdr args)) " ]")))) 1119 1120(defun do_unalias (args) 1121 (if (not (eq (length args) 1)) 1122 (warn "[ USAGE: unalias <alias> ]") 1123 1124 (unhash aliases (car args)) 1125 (warn "[ ALIAS " (car args) " REMOVED ]"))) 1126 1127; This function accepts a single command plucked out of the command line 1128; by "main" and rendered into a reversed list of discrete strings, and 1129; determines what to do with them. Each item in a multiple-command command 1130; line or pipeline will be passed as a separate list to this function. 1131 1132; The function first determines whether the command should be run in the 1133; foreground or the background. If it is part of a pipeline, when that 1134; information will be included with the last command in the pipeline. 1135 1136; Then it determines if the command is a user-function, a shell command 1137; or an external command. If it is an external command, the function 1138; verifies the command exists and is executable. 1139 1140; If the process is a command, a shell function, or a user-function, it is 1141; immediately invoked. If the process is part of a pipeline, the command 1142; particulars are stored on a list for later invocation when we receive the 1143; command list for the last process in the pipeline. 1144 1145(let ((start_bg 0) (cmd 0) (pipeline 0) (func "")) 1146 1147 (defun process_command (items) 1148 (setq start_bg 0) 1149 (setq pipeline 0) 1150 1151 (when items 1152 (cond ((eq (car items) "&") 1153 (setq start_bg 1) 1154 (setq items (cdr items))) 1155 1156 ((eq (car items) "|") 1157 (setq pipeline 1) 1158 (setq items (cdr items))))) 1159 1160 (when (setq items (reverse (get_redirections items))) 1161 (setq cmd (car items)) 1162 (setq items (cdr items)) 1163 1164 (cond ((eq cmd "fg") (if items (fg (car items)) (fg))) 1165 ((eq cmd "bg") (if items (bg (car items)) (bg))) 1166 ((eq cmd "exit") (while (> (car (wait -1 1)) 0)) (quit)) 1167 1168 ((eq cmd "alias") (do_alias items)) 1169 ((eq cmd "unalias") (do_unalias items)) 1170 ((eq cmd "aliases") (do_aliases)) 1171 1172 ((eq cmd "jobs") (do_jobs)) 1173 ((eq cmd "cd") (cd (and items (car items)))) 1174 ((eq cmd "exec") (do_exec items)) 1175 1176 ((eq cmd "prompt") (do_prompt items)) 1177 ((eq cmd "rescan") (rescan_path)) 1178 ((eq cmd ".") (interact) (newline)) 1179 1180 ((and (not (setq func (check_cmd (setq cmd (remove_quotes cmd))))) 1181 (not (setq func (lookup functions cmd)))) 1182 (warn "[ COMMAND " cmd " DOES NOT EXIST OR PERMISSION DENIED ]") 1183 (setq pipecmds ())) 1184 1185 (1 (cond ((and pipeline (stringp func)) 1186 (setq pipecmds 1187 (cons (list (get_redir2) func items 1188 (if pipecmds 0 (get_redir0))) 1189 pipecmds))) 1190 1191 ((closurep func) 1192 (apply func items) 1193 (setq pipecmds ())) 1194 1195 (1 (fork_it start_bg func items) 1196 (setq pipecmds ())))))))) 1197 1198; The final parenthesis of this closure, closes the giant wrapper closure. 1199 1200; This is the main function. It reads a line of input, and uses a regular 1201; expression to break it up into tokens. It then assembles the tokens into 1202; separate lists for each command found in the command line, feeding them 1203; to "process_command" one command at a time. 1204 1205(let ((items ()) (m ()) (line "") (multi "") 1206 (multi_rx (regcomp "[\b\t]\\\\[\b\t]*$")) 1207 (cmd_rx (regcomp (concat "^[" (char 10) (char 13) "\b\t]*(([^\b\t\"]|\\\\\")+|\"([^\"]|\\\\\")*\")(.*)")))) 1208 1209 (defun expand_alias (item) 1210 (or (reverse (lookup aliases item)) (list item))) 1211 1212 ; We map the closure to the string "main" in the user functions table. 1213 ; This mapping will be used to invoke the function from outside of the 1214 ; wrapper closure, and will be removed before any user code is run. 1215 1216 (hash functions "main" 1217 (defun main ((first)) 1218 1219 (catch 1220 (for (((setq line (or (and first (car first)) (getline prompt -3)))) 1221 (line) 1222 ((setq line (getline prompt -3)))) 1223 1224 (unless (setq line (chomp line)) 1225 (setq pipecmds ()) 1226 (setq multi "") 1227 (wait_for_bg) 1228 (continue)) 1229 1230 (when (match multi_rx line) 1231 (setq multi (concat multi (substitute multi_rx " " line))) 1232 (continue)) 1233 1234 (when multi 1235 (setq line (concat multi line)) 1236 (setq multi "")) 1237 1238 (while (setq m (matches cmd_rx line)) 1239 (setq items (append (expand_alias (cadr m)) items)) 1240 (setq line (caddddr m))) 1241 1242 (setq items (reverse items)) 1243 1244 (while items 1245 (setq m (cons (car items) m)) 1246 1247 (cond ((eq (car items) ";") 1248 (process_command (cdr m)) 1249 (canon) 1250 (setq m ())) 1251 1252 ((eq (car items) "|") 1253 (process_command m) 1254 (canon) 1255 (setq m ()))) 1256 1257 (setq items (cdr items))) 1258 1259 (when m 1260 (process_command m)) 1261 (canon) 1262 1263 (when first (throw 0)) 1264 (wait_for_bg)) 1265 1266 (save_history (join "/" (getenv "HOME") ".mush_history")) 1267 1268 (when stopped 1269 (warn "[ THERE ARE STOPPED JOBS ]") 1270 (beep) 1271 (tailcall 0))))))) ; Final parenthesis closes giant wrapper closure. 1272 1273(let ((rc (join "/" (getenv "HOME") ".mushrc"))) 1274 (when (eq 1 (exists rc)) 1275 (if (access rc 0) 1276 (load rc) 1277 (warn "[ ~/.mushrc: PERMISSION DENIED ]")))) 1278 1279; Trickery to make "main" visible outside of the giant wrapper closure 1280; without using globals. 1281 1282(let ((f (lookup functions "main"))) 1283 (unhash functions "main") 1284 1285 (next) 1286 1287 (if (next) 1288 (if (eq (current) "-c") 1289 (f (next)) 1290 1291 (do 1292 (with_input_file (current) 1293 (f)) 1294 (next))) 1295 1296 (when (isatty 1) 1297 (goto (lines) 0)) 1298 (f))) 1299 1300(while (> (car (wait -1 1)) 0)) 1301(quit) 1302