Artifact 9278a878515b5a3a2f04525e7f957322f3d6112b:
- File common.scm — part of check-in [ae6dbecf17] at 2011-05-01 23:05:22 on branch trunk — Importing 1.0.1 version of megatest, (nb// work in progress, please wait for next release) (user: matt size: 3589)
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy 0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 31 2c right 2006-2011, 0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland 0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p 0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a 0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t 00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi 00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr 00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a 00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file 00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det 00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th 0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di 0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU 0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY; 0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the 0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war 0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN 0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN 0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC 0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE 0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============ 01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 ==========..(use 01e0: 20 73 71 6c 69 74 65 33 20 73 72 66 69 2d 31 20 sqlite3 srfi-1 01f0: 70 6f 73 69 78 20 72 65 67 65 78 2d 63 61 73 65 posix regex-case 0200: 20 62 61 73 65 36 34 20 66 6f 72 6d 61 74 29 0a base64 format). 0210: 28 72 65 71 75 69 72 65 2d 65 78 74 65 6e 73 69 (require-extensi 0220: 6f 6e 20 73 71 6c 69 74 65 33 20 72 65 67 65 78 on sqlite3 regex 0230: 20 70 6f 73 69 78 29 0a 0a 28 69 6d 70 6f 72 74 posix)..(import 0240: 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 (prefix sqlite3 0250: 20 73 71 6c 69 74 65 33 3a 29 29 0a 28 69 6d 70 sqlite3:)).(imp 0260: 6f 72 74 20 28 70 72 65 66 69 78 20 62 61 73 65 ort (prefix base 0270: 36 34 20 62 61 73 65 36 34 3a 29 29 0a 0a 3b 3b 64 base64:))..;; 0280: 20 28 72 65 71 75 69 72 65 2d 6c 69 62 72 61 72 (require-librar 0290: 79 20 6d 61 72 67 73 29 0a 28 69 6e 63 6c 75 64 y margs).(includ 02a0: 65 20 22 6d 61 72 67 73 2e 73 63 6d 22 29 0a 0a e "margs.scm").. 02b0: 28 64 65 66 69 6e 65 20 67 65 74 65 6e 76 20 67 (define getenv g 02c0: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v 02d0: 61 72 69 61 62 6c 65 29 0a 0a 28 64 65 66 69 6e ariable)..(defin 02e0: 65 20 68 6f 6d 65 20 28 67 65 74 65 6e 76 20 22 e home (getenv " 02f0: 48 4f 4d 45 22 29 29 0a 28 64 65 66 69 6e 65 20 HOME")).(define 0300: 75 73 65 72 20 28 67 65 74 65 6e 76 20 22 55 53 user (getenv "US 0310: 45 52 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a ER"))..(define * 0320: 63 6f 6e 66 69 67 69 6e 66 6f 2a 20 23 66 29 0a configinfo* #f). 0330: 28 64 65 66 69 6e 65 20 2a 63 6f 6e 66 69 67 64 (define *configd 0340: 61 74 2a 20 20 23 66 29 0a 28 64 65 66 69 6e 65 at* #f).(define 0350: 20 2a 74 6f 70 70 61 74 68 2a 20 20 20 20 23 66 *toppath* #f 0360: 29 0a 28 64 65 66 69 6e 65 20 2a 61 6c 72 65 61 ).(define *alrea 0370: 64 79 2d 73 65 65 6e 2d 72 75 6e 63 6f 6e 66 69 dy-seen-runconfi 0380: 67 2d 69 6e 66 6f 2a 20 23 66 29 0a 28 64 65 66 g-info* #f).(def 0390: 69 6e 65 20 2a 77 61 69 74 69 6e 67 2d 71 75 65 ine *waiting-que 03a0: 75 65 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 ue* (make-hash-t 03b0: 61 62 6c 65 29 29 0a 0a 28 64 65 66 69 6e 65 2d able))..(define- 03c0: 69 6e 6c 69 6e 65 20 28 67 65 74 2d 77 69 74 68 inline (get-with 03d0: 2d 64 65 66 61 75 6c 74 20 76 61 6c 20 64 65 66 -default val def 03e0: 61 75 6c 74 29 0a 20 20 28 6c 65 74 20 28 28 76 ault). (let ((v 03f0: 61 6c 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 al (args:get-arg 0400: 20 76 61 6c 29 29 29 0a 20 20 20 20 28 69 66 20 val))). (if 0410: 76 61 6c 20 76 61 6c 20 64 65 66 61 75 6c 74 29 val val default) 0420: 29 29 0a 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 ))..(define-inli 0430: 6e 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c ne (assoc/defaul 0440: 74 20 6b 65 79 20 6c 73 74 20 2e 20 64 65 66 61 t key lst . defa 0450: 75 6c 74 29 0a 20 20 28 6c 65 74 20 28 28 72 65 ult). (let ((re 0460: 73 20 28 61 73 73 6f 63 20 6b 65 79 20 6c 73 74 s (assoc key lst 0470: 29 29 29 0a 20 20 20 20 28 69 66 20 72 65 73 20 ))). (if res 0480: 28 63 61 64 72 20 72 65 73 29 28 69 66 20 28 6e (cadr res)(if (n 0490: 75 6c 6c 3f 20 64 65 66 61 75 6c 74 29 20 23 66 ull? default) #f 04a0: 20 28 63 61 72 20 64 65 66 61 75 6c 74 29 29 29 (car default))) 04b0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;========== 04c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 04d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 04e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 04f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;; 0500: 4d 69 73 63 20 75 74 69 6c 73 0a 3b 3b 3d 3d 3d Misc utils.;;=== 0510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0550: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 ===..(define (ge 0560: 74 2d 64 66 20 70 61 74 68 29 0a 20 20 28 6c 65 t-df path). (le 0570: 74 2a 20 28 28 64 66 2d 72 65 73 75 6c 74 73 20 t* ((df-results 0580: 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 (cmd-run->list ( 0590: 63 6f 6e 63 20 22 64 66 20 22 20 70 61 74 68 29 conc "df " path) 05a0: 29 29 0a 09 20 28 73 70 61 63 65 2d 72 78 20 20 )).. (space-rx 05b0: 20 28 72 65 67 65 78 70 20 22 28 5b 30 2d 39 5d (regexp "([0-9] 05c0: 2b 29 5c 5c 73 2b 28 5b 30 2d 39 5d 2b 29 25 22 +)\\s+([0-9]+)%" 05d0: 29 29 0a 09 20 28 66 72 65 65 73 70 63 20 20 20 )).. (freespc 05e0: 20 23 66 29 29 0a 20 20 20 20 3b 3b 20 28 77 72 #f)). ;; (wr 05f0: 69 74 65 20 64 66 2d 72 65 73 75 6c 74 73 29 0a ite df-results). 0600: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l 0610: 61 6d 62 64 61 20 28 6c 29 0a 09 09 28 6c 65 74 ambda (l)...(let 0620: 20 28 28 6d 61 74 63 68 20 28 73 74 72 69 6e 67 ((match (string 0630: 2d 73 65 61 72 63 68 20 73 70 61 63 65 2d 72 78 -search space-rx 0640: 20 6c 29 29 29 0a 09 09 20 20 28 69 66 20 6d 61 l)))... (if ma 0650: 74 63 68 20 0a 09 09 20 20 20 20 20 20 28 6c 65 tch ... (le 0660: 74 20 28 28 6e 65 77 76 61 6c 20 28 73 74 72 69 t ((newval (stri 0670: 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 64 72 ng->number (cadr 0680: 20 6d 61 74 63 68 29 29 29 29 0a 09 09 09 28 69 match))))....(i 0690: 66 20 28 6e 75 6d 62 65 72 3f 20 6e 65 77 76 61 f (number? newva 06a0: 6c 29 0a 09 09 09 20 20 20 20 28 73 65 74 21 20 l).... (set! 06b0: 66 72 65 65 73 70 63 20 6e 65 77 76 61 6c 29 29 freespc newval)) 06c0: 29 29 29 29 0a 09 20 20 20 20 20 20 28 63 61 72 )))).. (car 06d0: 20 64 66 2d 72 65 73 75 6c 74 73 29 29 0a 20 20 df-results)). 06e0: 20 20 66 72 65 65 73 70 63 29 29 0a 20 20 0a 28 freespc)). .( 06f0: 64 65 66 69 6e 65 20 28 67 65 74 2d 63 70 75 2d define (get-cpu- 0700: 6c 6f 61 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 load). (let* (( 0710: 6c 6f 61 64 2d 72 65 73 20 28 63 6d 64 2d 72 75 load-res (cmd-ru 0720: 6e 2d 3e 6c 69 73 74 20 22 75 70 74 69 6d 65 22 n->list "uptime" 0730: 29 29 0a 09 20 28 6c 6f 61 64 2d 72 78 20 20 28 )).. (load-rx ( 0740: 72 65 67 65 78 70 20 22 6c 6f 61 64 20 61 76 65 regexp "load ave 0750: 72 61 67 65 3a 5c 5c 73 2b 28 5c 5c 64 2b 29 22 rage:\\s+(\\d+)" 0760: 29 29 0a 09 20 28 63 70 75 2d 6c 6f 61 64 20 23 )).. (cpu-load # 0770: 66 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 f)). (for-eac 0780: 68 20 28 6c 61 6d 62 64 61 20 28 6c 29 0a 09 09 h (lambda (l)... 0790: 28 6c 65 74 20 28 28 6d 61 74 63 68 20 28 73 74 (let ((match (st 07a0: 72 69 6e 67 2d 73 65 61 72 63 68 20 6c 6f 61 64 ring-search load 07b0: 2d 72 78 20 6c 29 29 29 0a 09 09 20 20 28 69 66 -rx l)))... (if 07c0: 20 6d 61 74 63 68 0a 09 09 20 20 20 20 20 20 28 match... ( 07d0: 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 28 73 74 let ((newval (st 07e0: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 ring->number (ca 07f0: 64 72 20 6d 61 74 63 68 29 29 29 29 0a 09 09 09 dr match)))).... 0800: 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 6e 65 77 (if (number? new 0810: 76 61 6c 29 0a 09 09 09 20 20 20 20 28 73 65 74 val).... (set 0820: 21 20 63 70 75 2d 6c 6f 61 64 20 6e 65 77 76 61 ! cpu-load newva 0830: 6c 29 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 l)))))).. ( 0840: 63 61 72 20 6c 6f 61 64 2d 72 65 73 29 29 0a 20 car load-res)). 0850: 20 20 20 63 70 75 2d 6c 6f 61 64 29 29 0a 0a 28 cpu-load))..( 0860: 64 65 66 69 6e 65 20 28 67 65 74 2d 75 6e 61 6d define (get-unam 0870: 65 20 2e 20 70 61 72 61 6d 73 29 0a 20 20 28 6c e . params). (l 0880: 65 74 2a 20 28 28 75 6e 61 6d 65 2d 72 65 73 20 et* ((uname-res 0890: 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 (cmd-run->list ( 08a0: 63 6f 6e 63 20 22 75 6e 61 6d 65 20 22 20 28 69 conc "uname " (i 08b0: 66 20 28 6e 75 6c 6c 3f 20 70 61 72 61 6d 73 29 f (null? params) 08c0: 20 22 2d 61 22 20 28 63 61 72 20 70 61 72 61 6d "-a" (car param 08d0: 73 29 29 29 29 29 0a 09 20 28 75 6e 61 6d 65 20 s))))).. (uname 08e0: 23 66 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 #f)). (if (nu 08f0: 6c 6c 3f 20 28 63 61 72 20 75 6e 61 6d 65 2d 72 ll? (car uname-r 0900: 65 73 29 29 0a 09 22 75 6e 6b 6e 6f 77 6e 22 0a es)).."unknown". 0910: 09 28 63 61 61 72 20 75 6e 61 6d 65 2d 72 65 73 .(caar uname-res 0920: 29 29 29 29 0a 09 20 20 20 20 20 20 0a 28 64 65 )))).. .(de 0930: 66 69 6e 65 20 28 73 61 76 65 2d 65 6e 76 69 72 fine (save-envir 0940: 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 onment-as-files 0950: 66 6e 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 fname). (let (( 0960: 65 6e 76 76 61 72 73 20 28 67 65 74 2d 65 6e 76 envvars (get-env 0970: 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c ironment-variabl 0980: 65 73 29 29 0a 20 20 20 20 20 20 20 20 28 77 68 es)). (wh 0990: 69 74 65 73 70 20 28 72 65 67 65 78 70 20 22 5b itesp (regexp "[ 09a0: 5e 61 2d 7a 41 2d 5a 30 2d 39 5f 5c 5c 2d 3a 3b ^a-zA-Z0-9_\\-:; 09b0: 2c 2e 5c 5c 2f 25 5d 22 29 29 29 0a 20 20 20 20 ,.\\/%]"))). 09c0: 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f (with-output-to 09d0: 2d 66 69 6c 65 20 28 63 6f 6e 63 20 66 6e 61 6d -file (conc fnam 09e0: 65 20 22 2e 63 73 68 22 29 0a 20 20 20 20 20 20 e ".csh"). 09f0: 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 (lambda (). 0a00: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each 0a10: 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 20 20 (lambda (key). 0a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a30: 20 20 20 20 28 6c 65 74 2a 20 28 28 76 61 6c 20 (let* ((val 0a40: 28 63 64 72 20 6b 65 79 29 29 0a 20 20 20 20 20 (cdr key)). 0a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a60: 20 20 20 20 20 20 20 20 28 73 76 61 6c 20 28 69 (sval (i 0a70: 66 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 f (string-search 0a80: 20 77 68 69 74 65 73 70 20 76 61 6c 29 28 63 6f whitesp val)(co 0a90: 6e 63 20 22 27 22 20 76 61 6c 20 22 27 22 29 20 nc "'" val "'") 0aa0: 76 61 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 val))). 0ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 0ac0: 70 72 69 6e 74 20 22 73 65 74 65 6e 76 20 22 20 print "setenv " 0ad0: 28 63 61 72 20 6b 65 79 29 20 22 20 22 20 73 76 (car key) " " sv 0ae0: 61 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 al))). 0af0: 20 20 20 20 20 20 20 20 20 20 20 65 6e 76 76 61 envva 0b00: 72 73 29 29 29 0a 20 20 20 20 20 28 77 69 74 68 rs))). (with 0b10: 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 -output-to-file 0b20: 28 63 6f 6e 63 20 66 6e 61 6d 65 20 22 2e 73 68 (conc fname ".sh 0b30: 22 29 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 64 "). (lambd 0b40: 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 28 a (). ( 0b50: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda 0b60: 20 28 6b 65 79 29 0a 20 20 20 20 20 20 20 20 20 (key). 0b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le 0b80: 74 2a 20 28 28 76 61 6c 20 28 63 64 72 20 6b 65 t* ((val (cdr ke 0b90: 79 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 y)). 0ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0bb0: 20 28 73 76 61 6c 20 28 69 66 20 28 73 74 72 69 (sval (if (stri 0bc0: 6e 67 2d 73 65 61 72 63 68 20 77 68 69 74 65 73 ng-search whites 0bd0: 70 20 76 61 6c 29 28 63 6f 6e 63 20 22 27 22 20 p val)(conc "'" 0be0: 76 61 6c 20 22 27 22 29 20 76 61 6c 29 29 29 0a val "'") val))). 0bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0c00: 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 (print 0c10: 22 65 78 70 6f 72 74 20 22 20 28 63 61 72 20 6b "export " (car k 0c20: 65 79 29 20 22 3d 22 20 73 76 61 6c 29 29 29 0a ey) "=" sval))). 0c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0c40: 20 20 20 20 65 6e 76 76 61 72 73 29 29 29 29 29 envvars))))) 0c50: 0a 0a 3b 3b 20 73 65 74 20 73 6f 6d 65 20 65 6e ..;; set some en 0c60: 76 20 76 61 72 73 20 66 72 6f 6d 20 61 6e 20 61 v vars from an a 0c70: 6c 69 73 74 2c 20 72 65 74 75 72 6e 20 61 6e 20 list, return an 0c80: 61 6c 69 73 74 20 77 69 74 68 20 6f 72 69 67 69 alist with origi 0c90: 6e 61 6c 20 76 61 6c 75 65 73 0a 3b 3b 20 28 28 nal values.;; (( 0ca0: 22 56 41 52 22 20 22 76 61 6c 75 65 22 29 20 2e "VAR" "value") . 0cb0: 2e 2e 29 0a 28 64 65 66 69 6e 65 20 28 61 6c 69 ..).(define (ali 0cc0: 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 6c 73 74 st->env-vars lst 0cd0: 29 0a 20 20 28 69 66 20 28 6c 69 73 74 3f 20 6c ). (if (list? l 0ce0: 73 74 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 st). (let ( 0cf0: 28 72 65 73 20 27 28 29 29 29 0a 09 28 66 6f 72 (res '()))..(for 0d00: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 70 -each (lambda (p 0d10: 29 0a 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 )... (let* (( 0d20: 76 61 72 20 28 63 61 72 20 20 70 29 29 0a 09 09 var (car p))... 0d30: 09 20 20 20 28 76 61 6c 20 28 63 61 64 72 20 70 . (val (cadr p 0d40: 29 29 0a 09 09 09 20 20 20 28 70 72 76 20 28 67 )).... (prv (g 0d50: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v 0d60: 61 72 69 61 62 6c 65 20 76 61 72 29 29 29 0a 09 ariable var))).. 0d70: 09 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 . (set! res 0d80: 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 76 61 72 (cons (list var 0d90: 20 70 72 76 29 20 72 65 73 29 29 0a 09 09 20 20 prv) res))... 0da0: 20 20 20 20 28 69 66 20 76 61 6c 20 0a 09 09 09 (if val .... 0db0: 20 20 28 73 65 74 65 6e 76 20 76 61 72 20 28 2d (setenv var (- 0dc0: 3e 73 74 72 69 6e 67 20 76 61 6c 29 29 0a 09 09 >string val))... 0dd0: 09 20 20 28 75 6e 73 65 74 65 6e 76 20 76 61 72 . (unsetenv var 0de0: 29 29 29 29 0a 09 09 20 20 6c 73 74 29 0a 09 72 ))))... lst)..r 0df0: 65 73 29 0a 20 20 20 20 20 20 27 28 29 29 29 0a es). '())). 0e00: 09 09 20 20 0a .. .