[clfswm-cvs] r287 - in clfswm/contrib: . server
Philippe Brochard
pbrochard at common-lisp.net
Thu Aug 12 21:30:53 UTC 2010
Author: pbrochard
Date: Thu Aug 12 17:30:52 2010
New Revision: 287
Log:
Add a clfswm server/client
Added:
clfswm/contrib/server/
clfswm/contrib/server/Makefile
clfswm/contrib/server/Makefile.template
clfswm/contrib/server/clfswm-client.asd
clfswm/contrib/server/clfswm-client.fas
clfswm/contrib/server/clfswm-client.lib
clfswm/contrib/server/clfswm-client.lisp
clfswm/contrib/server/configure (contents, props changed)
clfswm/contrib/server/crypt.fas
clfswm/contrib/server/crypt.lib
clfswm/contrib/server/crypt.lisp
clfswm/contrib/server/key.fas
clfswm/contrib/server/key.lib
clfswm/contrib/server/key.lisp
clfswm/contrib/server/load.lisp
clfswm/contrib/server/md5.fas
clfswm/contrib/server/md5.lib
clfswm/contrib/server/md5.lisp
clfswm/contrib/server/net.fas
clfswm/contrib/server/net.lib
clfswm/contrib/server/net.lisp
clfswm/contrib/server/server.lisp
clfswm/contrib/server/test.sh (contents, props changed)
clfswm/contrib/server/test2.sh (contents, props changed)
clfswm/contrib/server/util-server.asd
Modified:
clfswm/contrib/README
Modified: clfswm/contrib/README
==============================================================================
--- clfswm/contrib/README (original)
+++ clfswm/contrib/README Thu Aug 12 17:30:52 2010
@@ -1,9 +1,9 @@
The contrib directory is here if you want to contribute to CLFSWM and
if your code is not merged in the clfswm core.
-To contribute, place your files in the contrib directory.
+To contribute, place your files in the contrib directory.
You can have your own repository and tell me if you want to merge it
-in the clfswm svn.
+in the clfswm svn/git.
To use a contributed code add a line like this in your configuration
file:
Added: clfswm/contrib/server/Makefile
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/Makefile Thu Aug 12 17:30:52 2010
@@ -0,0 +1,49 @@
+# -*- makefile -*-
+PROJECT_NAME=clfswm-client
+DESTDIR=/tmp/local
+
+LISP=/usr/bin/clisp
+EVAL_OPT=-x -q
+LOAD_OPT=
+EXT=fas
+CORE=
+EXTRA_OPT=
+
+all: build
+ @echo "ALL"
+
+build:
+ @echo "Building"
+ $(LISP) $(CORE) $(EVAL_OPT) '(progn (pushnew :BUILD *features*) (load "load.lisp") (quit))'
+ @echo ""
+ @echo "Type 'make install' to install $(PROJECT_NAME) in '$(DESTDIR)/bin/$(PROJECT_NAME)'"
+ @echo ""
+
+install:
+ @echo "1) Installing: Creating directories"
+ mkdir -p $(DESTDIR)/lib/$(PROJECT_NAME)/
+ mkdir -p $(DESTDIR)/bin
+ @echo "2) Installing: Copying files"
+ cp -R `pwd`/../asdf.lisp $(DESTDIR)/lib/$(PROJECT_NAME)/
+ cp -R `pwd`/*.asd $(DESTDIR)/lib/$(PROJECT_NAME)/
+ cp -R `pwd`/*.lisp $(DESTDIR)/lib/$(PROJECT_NAME)/
+ @sleep 1
+ cp -R `pwd`/*.$(EXT) $(DESTDIR)/lib/$(PROJECT_NAME)/
+ @echo "3) Installing: Creating starter script"
+ echo "#!/bin/sh" > $(DESTDIR)/bin/$(PROJECT_NAME)
+ echo "$(LISP) $(CORE) $(LOAD_OPT) $(DESTDIR)/lib/$(PROJECT_NAME)/load.lisp $(EXTRA_OPT) \"\$$*\"" >> $(DESTDIR)/bin/$(PROJECT_NAME)
+ chmod a+x $(DESTDIR)/bin/$(PROJECT_NAME)
+ @echo ""
+ @echo "$(PROJECT_NAME) has been installed in '$(DESTDIR)/bin/$(PROJECT_NAME)'"
+ @echo ""
+
+
+uninstall:
+ rm -rf $(DESTDIR)/bin/$(PROJECT_NAME)
+ rm -rf $(DESTDIR)/lib/$(PROJECT_NAME)/
+
+clean:
+ find . \( -name "*~" -o -name "*.fas" -o -name "*.fasl" -o -name "*.lib" -o -name "*.lx32fsl" -o -name "*.x86f" \) -print0 | xargs -0 rm -f
+
+dist: clean
+ cd .. && tar czvf $(PROJECT_NAME)-`date +%y%m%d`.tar.gz $(PROJECT_NAME)
Added: clfswm/contrib/server/Makefile.template
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/Makefile.template Thu Aug 12 17:30:52 2010
@@ -0,0 +1,49 @@
+# -*- makefile -*-
+PROJECT_NAME=+PROJECT_NAME+
+DESTDIR=+DESTDIR+
+
+LISP=+LISP+
+EVAL_OPT=+EVAL_OPT+
+LOAD_OPT=+LOAD_OPT+
+EXT=+EXT+
+CORE=+CORE+
+EXTRA_OPT=+EXTRA_OPT+
+
+all: build
+ @echo "ALL"
+
+build:
+ @echo "Building"
+ $(LISP) $(CORE) $(EVAL_OPT) '(progn (pushnew :BUILD *features*) (load "load.lisp") (quit))'
+ @echo ""
+ @echo "Type 'make install' to install $(PROJECT_NAME) in '$(DESTDIR)/bin/$(PROJECT_NAME)'"
+ @echo ""
+
+install:
+ @echo "1) Installing: Creating directories"
+ mkdir -p $(DESTDIR)/lib/$(PROJECT_NAME)/
+ mkdir -p $(DESTDIR)/bin
+ @echo "2) Installing: Copying files"
+ cp -R `pwd`/../asdf.lisp $(DESTDIR)/lib/$(PROJECT_NAME)/
+ cp -R `pwd`/*.asd $(DESTDIR)/lib/$(PROJECT_NAME)/
+ cp -R `pwd`/*.lisp $(DESTDIR)/lib/$(PROJECT_NAME)/
+ @sleep 1
+ cp -R `pwd`/*.$(EXT) $(DESTDIR)/lib/$(PROJECT_NAME)/
+ @echo "3) Installing: Creating starter script"
+ echo "#!/bin/sh" > $(DESTDIR)/bin/$(PROJECT_NAME)
+ echo "$(LISP) $(CORE) $(LOAD_OPT) $(DESTDIR)/lib/$(PROJECT_NAME)/load.lisp $(EXTRA_OPT) \"\$$*\"" >> $(DESTDIR)/bin/$(PROJECT_NAME)
+ chmod a+x $(DESTDIR)/bin/$(PROJECT_NAME)
+ @echo ""
+ @echo "$(PROJECT_NAME) has been installed in '$(DESTDIR)/bin/$(PROJECT_NAME)'"
+ @echo ""
+
+
+uninstall:
+ rm -rf $(DESTDIR)/bin/$(PROJECT_NAME)
+ rm -rf $(DESTDIR)/lib/$(PROJECT_NAME)/
+
+clean:
+ find . \( -name "*~" -o -name "*.fas" -o -name "*.fasl" -o -name "*.lib" -o -name "*.lx32fsl" -o -name "*.x86f" \) -print0 | xargs -0 rm -f
+
+dist: clean
+ cd .. && tar czvf $(PROJECT_NAME)-`date +%y%m%d`.tar.gz $(PROJECT_NAME)
Added: clfswm/contrib/server/clfswm-client.asd
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/clfswm-client.asd Thu Aug 12 17:30:52 2010
@@ -0,0 +1,20 @@
+;;;; -*- Mode: Lisp -*-
+;;;; ASDF System Definition
+;;;
+
+(in-package #:asdf)
+
+(defsystem clfswm-client
+ :description ""
+ :licence "GNU Lesser General Public License (LGPL)"
+ :components ((:file "clfswm-client"))
+ :depends-on (util-server))
+
+
+
+
+
+
+
+
+
Added: clfswm/contrib/server/clfswm-client.fas
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/clfswm-client.fas Thu Aug 12 17:30:52 2010
@@ -0,0 +1,159 @@
+(|SYSTEM|::|VERSION| '(20080430.))
+#0Y_ #0Y |CHARSET|::|UTF-8|
+#Y(#:|1 1 (IN-PACKAGE :COMMON-LISP-USER)-1|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA 31 F6 0F 01 19 01)
+ ("COMMON-LISP-USER" |COMMON-LISP|::|*PACKAGE*|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|3 4 (DEFPACKAGE :CLFSWM-CLIENT (:USE :COMMON-LISP :CRYPT))-2-1|
+ #18Y(00 00 00 00 00 00 00 00 20 01 DA 01 04 31 F0 3E 19 01)
+ ("CLFSWM-CLIENT")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|3 4 (DEFPACKAGE :CLFSWM-CLIENT (:USE :COMMON-LISP :CRYPT))-2-2|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA DB 31 EC 3E 19 01)
+ (("COMMON-LISP" "CRYPT") "CLFSWM-CLIENT")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|3 4 (DEFPACKAGE :CLFSWM-CLIENT (:USE :COMMON-LISP :CRYPT))-2-3|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 D9 19 01) ("CLFSWM-CLIENT")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+#Y(#:|6 6 (IN-PACKAGE :CLFSWM-CLIENT)-3|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA 31 F6 0F 01 19 01)
+ ("CLFSWM-CLIENT" |COMMON-LISP|::|*PACKAGE*|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|8 18 (DEFUN ARGS NIL ...)-4|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CLFSWM-CLIENT|::|ARGS| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CLFSWM-CLIENT|::|ARGS| #14Y(00 00 00 00 00 00 00 00 26 01 0E 00 19 01)
+ (|EXT|::|*ARGS*|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|) ()
+ |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|20 27 (DEFUN UQUIT NIL ...)-5|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CLFSWM-CLIENT|::|UQUIT| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CLFSWM-CLIENT|::|UQUIT| #14Y(00 00 00 00 00 00 00 00 26 01 2E 00 19 01)
+ (|EXT|::|QUIT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|) ()
+ |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|31 31 (DEFPARAMETER *SERVER-PORT* 33333)-6|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 DB DC 31 5A C6 19 01)
+ ((|COMMON-LISP|::|SPECIAL| |CLFSWM-CLIENT|::|*SERVER-PORT*|)
+ |CLFSWM-CLIENT|::|*SERVER-PORT*| 33333.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|33 38 (DEFUN PRINT-OUTPUT (SOCK &OPTIONAL WAIT) ...)-7|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CLFSWM-CLIENT|::|PRINT-OUTPUT| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CLFSWM-CLIENT|::|PRINT-OUTPUT|
+ #114Y(03 00 01 00 01 00 01 00 26 08 00 2B 01 7F 03 00 00 3B 02 07 7D 02
+ 93 02 05 1B 2B 92 02 28 47 00 23 AE 6D 01 01 B0 6D 02 01 57 03 B0
+ 36 00 16 06 48 1F 3D 1B 11 58 67 00 00 01 76 00 AD 36 01 18 03 01
+ 19 02 1F 2A 47 00 10 AE 6D 04 01 B0 6D 05 01 57 06 B0 36 00 16 06
+ 48 14 9D 1F 11 E1 6B 08 AE 6B 09 70 0A 33 02 15 38 01 31 9B 19 05
+ 19 05 19 04)
+ (|COMMON-LISP|::|NIL|
+ #Y(|CLFSWM-CLIENT|::|PRINT-OUTPUT-1|
+ #16Y(00 00 00 00 00 00 00 00 26 01 DA 2C 01 01 19 01)
+ (|COMMON-LISP|::|NIL|
+ #Y(|CLFSWM-CLIENT|::|PRINT-OUTPUT-1-1|
+ #13Y(00 00 00 00 01 00 00 00 26 02 00 49 00)
+ (|COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|CONDITION|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|) ()
+ |COMMON-LISP|::|NIL| 1)
+ #Y(|CLFSWM-CLIENT|::|PRINT-OUTPUT-2|
+ #17Y(00 00 00 00 00 00 00 00 26 01 69 00 01 31 86 19 01)
+ (|COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|) ()
+ |COMMON-LISP|::|NIL| 1)
+ (#(|COMMON-LISP|::|ERROR| 43.) 2. . 1.)
+ #Y(|CLFSWM-CLIENT|::|PRINT-OUTPUT-3|
+ #16Y(00 00 00 00 00 00 00 00 26 01 DA 2C 01 01 19 01)
+ (|COMMON-LISP|::|NIL|
+ #Y(|CLFSWM-CLIENT|::|PRINT-OUTPUT-3-1|
+ #13Y(00 00 00 00 01 00 00 00 26 02 00 49 00)
+ (|COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|CONDITION|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|) ()
+ |COMMON-LISP|::|NIL| 1)
+ #Y(|CLFSWM-CLIENT|::|PRINT-OUTPUT-4|
+ #24Y(00 00 00 00 00 00 00 00 26 01 DB 69 00 01 01 02 38 01 71 82 30
+ 02 19 01)
+ (|COMMON-LISP|::|NIL| (#\Newline) |COMMON-LISP|::|STRING-TRIM|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|) ()
+ |COMMON-LISP|::|NIL| 1)
+ (#(|COMMON-LISP|::|ERROR| 43.) 2. . 1.)
+ #Y(|CLFSWM-CLIENT|::|PRINT-OUTPUT-5|
+ #20Y(00 00 00 00 02 00 00 00 21 18 AF 31 98 AE B0 31 90 9E 19 04) ()
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|*STANDARD-OUTPUT*| |CRYPT|::|*KEY*| |CRYPT|::|DECRYPT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|CLFSWM-CLIENT|::|SOCK| |COMMON-LISP|::|&OPTIONAL|
+ |CLFSWM-CLIENT|::|WAIT|)
+ |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|41 48 (DEFUN QUIT-ON-COMMAND (LINE SOCK) ...)-8|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CLFSWM-CLIENT|::|QUIT-ON-COMMAND| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CLFSWM-CLIENT|::|QUIT-ON-COMMAND|
+ #59Y(00 00 00 00 02 00 00 00 26 03 AE DA DB 38 02 31 C1 1F 26 63 1B 0F
+ DC 6B 03 AE 6B 04 70 05 33 02 15 38 01 31 9B AE 01 02 38 01 80 82
+ 00 1C 67 16 01 38 01 31 97 2E 06 19 03 19 03)
+ (("quit" "close" "bye") #.#'|COMMON-LISP|::|STRING-EQUAL|
+ #Y(|CLFSWM-CLIENT|::|QUIT-ON-COMMAND-1|
+ #20Y(00 00 00 00 02 00 00 00 21 18 AF 31 98 AE B0 31 90 9E 19 04) ()
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|*STANDARD-OUTPUT*| |CRYPT|::|*KEY*| |CRYPT|::|DECRYPT|
+ |CLFSWM-CLIENT|::|UQUIT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|CLFSWM-CLIENT|::|LINE| |CLFSWM-CLIENT|::|SOCK|) |COMMON-LISP|::|NIL|
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|51 61 (DEFUN PARSE-ARGS (SOCK ARGS) ...)-9|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CLFSWM-CLIENT|::|PARSE-ARGS| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CLFSWM-CLIENT|::|PARSE-ARGS|
+ #79Y(00 00 00 00 02 00 00 00 26 03 AD DA 38 04 8C 35 3B AD 38 05 31 89
+ 42 02 38 02 72 8F AE AD 31 90 AC 81 90 00 DB 6B 02 AE 33 02 15 B1
+ DD AE 6B 04 70 05 2D 03 06 B1 31 9B B1 64 30 07 AC B2 30 08 B1 B1
+ AF 38 01 72 60 29 02 08 FF BE 00 19 03)
+ (""
+ #Y(|CLFSWM-CLIENT|::|PARSE-ARGS-1|
+ #23Y(00 00 00 00 02 00 00 00 21 18 AE B0 31 90 DA B0 38 02 31 95 9E
+ 19 04)
+ ("\n
+ ")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|*STANDARD-OUTPUT*|
+ #Y(|CLFSWM-CLIENT|::|PARSE-ARGS-2|
+ #20Y(00 00 00 00 02 00 00 00 21 18 AE B0 31 90 AF 31 97 9E 19 04) ()
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |CRYPT|::|*KEY*| |CRYPT|::|CRYPT| |COMMON-LISP|::|FORMAT|
+ |CLFSWM-CLIENT|::|PRINT-OUTPUT| |CLFSWM-CLIENT|::|QUIT-ON-COMMAND|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|CLFSWM-CLIENT|::|SOCK| |CLFSWM-CLIENT|::|ARGS|) |COMMON-LISP|::|NIL|
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|64 80 (DEFUN START-CLIENT (&OPTIONAL # #) ...)-10|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CLFSWM-CLIENT|::|START-CLIENT| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CLFSWM-CLIENT|::|START-CLIENT|
+ #144Y(00 00 00 00 00 00 02 00 26 0C 3B 02 02 C5 FA 3B 01 03 0E 01 F9 2E
+ 02 AE AE 70 03 DE AD 01 02 38 01 71 82 6B 05 70 06 70 07 E2 AD 6B
+ 05 33 02 26 0F 05 38 02 72 8F 6B 05 6B 05 6F 09 AD AF 31 90 AC AF
+ 31 90 16 02 AC 81 90 00 6B 05 70 0A AE 38 02 31 96 AD 31 9B AD 64
+ 30 0B 2E 0C 14 63 1B 09 87 01 00 AF AD 30 0D 83 01 AD 8D 9F 73 16
+ 02 AD 2F 0B 38 01 8D 86 78 38 04 71 82 AC 6B 05 70 0A AF 38 02 31
+ 96 AE 31 9B AC AF 30 0E 16 01 1B 5F)
+ (#1="127.0.0.1" |CLFSWM-CLIENT|::|*SERVER-PORT*| |CRYPT|::|LOAD-NEW-KEY|
+ |PORT|::|OPEN-SOCKET| (#\Newline #\Space) |CRYPT|::|*KEY*|
+ |CRYPT|::|DECRYPT| |COMMON-LISP|::|STRING-TRIM| |COMMON-LISP|::|STRING|
+ |MD5|::|MD5| |CRYPT|::|CRYPT| |CLFSWM-CLIENT|::|PRINT-OUTPUT|
+ |CLFSWM-CLIENT|::|ARGS| |CLFSWM-CLIENT|::|PARSE-ARGS|
+ |CLFSWM-CLIENT|::|QUIT-ON-COMMAND|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|&OPTIONAL| (|CLFSWM-CLIENT|::|URL| #1#)
+ (|CLFSWM-CLIENT|::|PORT| |CLFSWM-CLIENT|::|*SERVER-PORT*|))
+ |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
Added: clfswm/contrib/server/clfswm-client.lib
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/clfswm-client.lib Thu Aug 12 17:30:52 2010
@@ -0,0 +1,30 @@
+#0Y_ #0Y |CHARSET|::|UTF-8|
+(|COMMON-LISP|::|SETQ| |COMMON-LISP|::|*PACKAGE*|
+ (|SYSTEM|::|%FIND-PACKAGE| "COMMON-LISP-USER"))
+(|SYSTEM|::|%IN-PACKAGE| "CLFSWM-CLIENT" :|NICKNAMES| '|COMMON-LISP|::|NIL|
+ :|USE| '|COMMON-LISP|::|NIL| :|CASE-SENSITIVE| |COMMON-LISP|::|NIL|
+ :|CASE-INVERTED| |COMMON-LISP|::|NIL|)
+(|COMMON-LISP|::|USE-PACKAGE| '("COMMON-LISP" "CRYPT") "CLFSWM-CLIENT")
+(|COMMON-LISP|::|FIND-PACKAGE| "CLFSWM-CLIENT")
+(|COMMON-LISP|::|SETQ| |COMMON-LISP|::|*PACKAGE*|
+ (|SYSTEM|::|%FIND-PACKAGE| "CLFSWM-CLIENT"))
+(|SYSTEM|::|C-DEFUN| '|CLFSWM-CLIENT|::|ARGS|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '|COMMON-LISP|::|NIL|))
+(|SYSTEM|::|C-DEFUN| '|CLFSWM-CLIENT|::|UQUIT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '|COMMON-LISP|::|NIL|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|SPECIAL| |CLFSWM-CLIENT|::|*SERVER-PORT*|))
+(|SYSTEM|::|C-DEFUN| '|CLFSWM-CLIENT|::|PRINT-OUTPUT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|CLFSWM-CLIENT|::|SOCK| |COMMON-LISP|::|&OPTIONAL|
+ |CLFSWM-CLIENT|::|WAIT|)))
+(|SYSTEM|::|C-DEFUN| '|CLFSWM-CLIENT|::|QUIT-ON-COMMAND|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|CLFSWM-CLIENT|::|LINE| |CLFSWM-CLIENT|::|SOCK|)))
+(|SYSTEM|::|C-DEFUN| '|CLFSWM-CLIENT|::|PARSE-ARGS|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|CLFSWM-CLIENT|::|SOCK| |CLFSWM-CLIENT|::|ARGS|)))
+(|SYSTEM|::|C-DEFUN| '|CLFSWM-CLIENT|::|START-CLIENT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|&OPTIONAL| (|CLFSWM-CLIENT|::|URL| "127.0.0.1")
+ (|CLFSWM-CLIENT|::|PORT| |CLFSWM-CLIENT|::|*SERVER-PORT*|))))
Added: clfswm/contrib/server/clfswm-client.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/clfswm-client.lisp Thu Aug 12 17:30:52 2010
@@ -0,0 +1,81 @@
+(in-package :common-lisp-user)
+
+(defpackage :clfswm-client
+ (:use :common-lisp :crypt))
+
+(in-package :clfswm-client)
+
+(defun args ()
+ #+sbcl (cdr sb-ext:*posix-argv*)
+ #+(or clozure ccl) (cddddr (ccl::command-line-arguments))
+ #+gcl (cdr si:*command-args*)
+ #+ecl (loop for i from 1 below (si:argc) collect (si:argv i))
+ #+cmu (cdddr extensions:*command-line-strings*)
+ #+allegro (cdr (sys:command-line-arguments))
+ #+lispworks (cdr sys:*line-arguments-list*)
+ #+clisp ext:*args*
+ #-(or sbcl clozure gcl ecl cmu allegro lispworks clisp)
+ (error "get-command-line-arguments not supported for your implementation"))
+
+(defun uquit ()
+ #+(or clisp cmu) (ext:quit)
+ #+sbcl (sb-ext:quit)
+ #+ecl (si:quit)
+ #+gcl (lisp:quit)
+ #+lispworks (lw:quit)
+ #+(or allegro-cl allegro-cl-trial) (excl:exit)
+ #+ccl (ccl:quit))
+
+
+
+(defparameter *server-port* 33333)
+
+(defun print-output (sock &optional wait)
+ (when (or wait (ignore-errors (listen sock)))
+ (let ((line (ignore-errors (string-trim '(#\newline) (read-line sock nil nil)))))
+ (when line
+ (format t "~&~A" (decrypt line *key*))
+ (force-output)))))
+
+
+(defun quit-on-command (line sock)
+ (when (member line '("quit" "close" "bye") :test #'string-equal)
+ (loop for line = (read-line sock nil nil)
+ while line
+ do (format t "~&~A" (decrypt line *key*))
+ (force-output))
+ (terpri)
+ (uquit)))
+
+
+(defun parse-args (sock args)
+ (unless (string= args "")
+ (multiple-value-bind (form pos)
+ (read-from-string args)
+ (let ((str (format nil "~A" form)))
+ (format t "~A~% " str)
+ (format sock "~A~%" (crypt str *key*))
+ (force-output sock)
+ (print-output sock t)
+ (quit-on-command str sock)
+ (parse-args sock (subseq args pos))))))
+
+
+(defun start-client (&optional (url "127.0.0.1") (port *server-port*))
+ (load-new-key)
+ (let* ((sock (port:open-socket url port))
+ (key (string-trim '(#\Newline #\Space) (decrypt (read-line sock nil nil) *key*))))
+ (setf *key* (concatenate 'string key *key*))
+ (write-line (crypt (format nil "~A~A" *key* (md5:md5 *key*)) *key*) sock)
+ (force-output sock)
+ (print-output sock t)
+ (dolist (a (args))
+ (parse-args sock a))
+ (loop
+ (print-output sock)
+ (when (listen)
+ (let ((line (read-line)))
+ (write-line (crypt line *key*) sock)
+ (force-output sock)
+ (quit-on-command line sock))))))
+
Added: clfswm/contrib/server/configure
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/configure Thu Aug 12 17:30:52 2010
@@ -0,0 +1,129 @@
+#! /bin/sh
+
+PROJECT_NAME=clfswm-client
+CONFIGURE_VERSION=0.1
+
+
+usage () {
+ echo "'configure' configures $PROJECT_NAME to adapt to many kinds of systems.
+
+Usage: ./configure [OPTION]... [VAR=VALUE]...
+
+Please, be sure to edit the file key.lisp to change the encryption key. And
+protect this file from unwanted eyes.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+ -h, --help display this help and exit
+ -V, --version display version information and exit
+ --with-lisp=LISP use a particular Lisp implementation [ask]
+ --with-lisp-eval-opt=OPT use a particular Lisp eval command line option
+ --with-lisp-load-opt=OPT use a particular Lisp load command line option
+ --with-lisp-ext=OPT use a particular Lisp extension filename
+ --with-lisp-core=CORE use a particular Lisp core (initial memory image)
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [/usr/local]
+
+By default, 'make install' will install all the files in
+'/usr/local/bin', '/usr/local/lib' etc. You can specify
+an installation prefix other than '/usr/local' using '--prefix',
+for instance '--prefix=$HOME'."
+ exit 0
+}
+
+
+version () {
+ echo "Configure version: $CONFIGURE_VERSION"
+ exit 0
+}
+
+
+
+TEMP=`getopt -o hV: --long help,version,srcdir:,with-lisp:,with-lisp-eval-opt:,with-lisp-load-opt:,with-lisp-ext:,with-lisp-core:,prefix: -- "$@"`
+PREFIX=/usr/local
+
+if [ $? != 0 ] ; then echo "Terminating..." >&2 ; exit 1 ; fi
+
+eval set -- "$TEMP"
+
+while true ; do
+ case "$1" in
+ -h|--help) usage ; shift ;;
+ -V|--version) version ; shift ;;
+ --srcdir) SRCDIR=$2 ; shift 2 ;;
+ --with-lisp) LISP=$2 ; shift 2 ;;
+ --with-lisp-eval-opt) EVAL_OPT=$2 ; shift 2 ;;
+ --with-lisp-load-opt) LOAD_OPT=$2 ; shift 2 ;;
+ --with-lisp-ext) EXT=$2 ; shift 2 ;;
+ --with-lisp-core) CORE=$2 ; shift 2 ;;
+ --prefix) PREFIX=$2 ; shift 2 ;;
+ --key-perms) KEY_PERMS=$2 ; shift 2 ;;
+ --) shift ; break ;;
+ *) echo "Internal error!" ; exit 1 ;;
+ esac
+done
+
+DESTDIR=$PREFIX
+
+
+if [ "x$LISP" = "x" ]; then
+ echo "Please, choose a Lisp implementation in:
+1) SBCL 2) CMUCL 3) CLISP 4) ECL 5) CCL 6) Other"
+ read REP_LISP
+ case $REP_LISP in
+ 1) LISP=sbcl ;;
+ 2) LISP=cmucl ;;
+ 3) LISP=clisp ;;
+ 4) LISP=ecl ;;
+ 5) LISP=ccl ;;
+ 6) echo -n "Please, enter your Lisp implementation: "
+ read LISP ;;
+ *) echo "Error"; exit -1 ;;
+ esac
+fi
+
+EXTRA_OPT=""
+
+case $LISP in
+ clisp) LISP=$(which clisp)
+ EVAL_OPT="-x -q"
+ LOAD_OPT=""
+ EXT=fas ;;
+ sbcl) LISP=$(which sbcl)
+ EVAL_OPT="--eval"
+ LOAD_OPT="--load"
+ EXT=fasl ;;
+ cmucl) LISP=$(which cmucl)
+ EVAL_OPT="-eval"
+ LOAD_OPT="-load"
+ EXT=x86f ;;
+ ecl) LISP=$(which ecl)
+ EVAL_OPT="-eval"
+ LOAD_OPT="-load"
+ EXT=fas ;;
+ ccl) LISP=$(which ccl)
+ EVAL_OPT="-e"
+ LOAD_OPT="-l"
+ EXT=lx32fsl
+ EXTRA_OPT="--" ;;
+esac
+
+echo "Configuration:"
+echo SRCDIR = $SRCDIR
+echo PREFIX = $PREFIX
+echo "LISP=$LISP EVAL_OPT=$EVAL_OPT LOAD_OPT=$LOAD_OPT EXT=$EXT CORE=$CORE EXTRA_OPT=$EXTRA_OPT"
+
+sed -e "s#+PROJECT_NAME+#$PROJECT_NAME#g" \
+ -e "s#+DESTDIR+#$DESTDIR#g" \
+ -e "s#+LISP+#$LISP#g" \
+ -e "s#+EVAL_OPT+#$EVAL_OPT#g" \
+ -e "s#+LOAD_OPT+#$LOAD_OPT#g" \
+ -e "s#+EXT+#$EXT#g" \
+ -e "s#+CORE+#$CORE#g" \
+ -e "s#+EXTRA_OPT+#$EXTRA_OPT#g" \
+ Makefile.template > Makefile
+
+echo ""
+echo "Type 'make' to build $PROJECT_NAME"
+echo ""
Added: clfswm/contrib/server/crypt.fas
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/crypt.fas Thu Aug 12 17:30:52 2010
@@ -0,0 +1,210 @@
+(|SYSTEM|::|VERSION| '(20080430.))
+#0Y_ #0Y |CHARSET|::|UTF-8|
+#Y(#:|1 1 (IN-PACKAGE :COMMON-LISP-USER)-1|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA 31 F6 0F 01 19 01)
+ ("COMMON-LISP-USER" |COMMON-LISP|::|*PACKAGE*|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|3 7 (DEFPACKAGE :CRYPT (:USE :COMMON-LISP) ...)-2-1|
+ #18Y(00 00 00 00 00 00 00 00 20 01 DA 01 04 31 F0 3E 19 01) ("CRYPT")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|3 7 (DEFPACKAGE :CRYPT (:USE :COMMON-LISP) ...)-2-2|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA DB 31 EC 3E 19 01)
+ (("COMMON-LISP") "CRYPT")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|3 7 (DEFPACKAGE :CRYPT (:USE :COMMON-LISP) ...)-2-3|
+ #19Y(00 00 00 00 00 00 00 00 20 01 DA DB 63 2D 03 02 3E 19 01)
+ ((#1="CRYPT" "DECRYPT" "GENERATE-KEY") #1# |SYSTEM|::|INTERN-EXPORT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|3 7 (DEFPACKAGE :CRYPT (:USE :COMMON-LISP) ...)-2-4|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 D9 19 01) ("CRYPT")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+#Y(#:|9 9 (IN-PACKAGE :CRYPT)-3|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA 31 F6 0F 01 19 01)
+ ("CRYPT" |COMMON-LISP|::|*PACKAGE*|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|11 18 (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (DEFUN MKSTR # ...) ...)-4-1|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C 3E 19 01)
+ (|CRYPT|::|MKSTR| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CRYPT|::|MKSTR|
+ #51Y(03 00 01 00 00 00 00 00 27 16 DA 38 01 72 8F 53 17 B0 63 1B 09 87
+ 01 00 14 B1 31 90 83 01 AD 8D 9F 73 16 02 AE 32 90 54 67 00 00 00
+ 38 01 32 97 55 19 03)
+ (|COMMON-LISP|::|CHARACTER|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|&REST| |CRYPT|::|ARGS|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|11 18 (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (DEFUN MKSTR # ...) ...)-4-2|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CRYPT|::|SYMB| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CRYPT|::|SYMB|
+ #22Y(00 00 00 00 00 00 00 00 27 16 99 00 9F 77 00 38 01 31 E1 3F 19 02)
+ (|CRYPT|::|MKSTR|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|&REST| |CRYPT|::|ARGS|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|22 55 (DEFMACRO CIRC-LOOP (BINDING &BODY BODY) ...)-5|
+ #23Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 72 4C 32 9C C5 19 01)
+ (|CRYPT|::|CIRC-LOOP| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CRYPT|::|CIRC-LOOP|
+ #72Y(00 00 00 00 02 00 00 00 26 03 AE DA DA 64 2D 04 01 1D 30 9F 5C 78
+ A0 5C 79 63 6D 03 01 63 6D 04 01 63 6D 05 01 38 01 72 AA E0 AD B3
+ CC 74 E2 AF B5 A5 74 B5 A4 74 E3 B7 A5 74 A8 5D 7A 7B 04 61 03 19
+ 09 AE 2F 02 19 03)
+ (2. |SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|MACRO-CALL-ERROR|
+ #Y(|CRYPT|::|CIRC-LOOP-DO-BODY|
+ #83Y(00 00 00 00 02 00 00 00 26 03 94 01 C6 74 AF DC DD 6E 03 04 DF
+ 94 04 C6 74 7B 02 7B 03 E0 95 03 01 02 1B 23 87 02 01 14 C6 74
+ B4 E1 B2 6E 03 04 E2 DF B1 C6 74 7B 02 B7 E3 B5 6E 03 04 7B 03
+ 7B 03 84 00 85 03 83 02 AE 8D 9F 59 AC 31 B1 16 04 5D 19 03)
+ (|COMMON-LISP|::|NIL|
+ #1=#Y(|CRYPT|::|CIRC-LOOP-LOOP-VAR-NAME|
+ #17Y(00 00 00 00 01 00 00 00 26 02 DA 94 02 30 01 19 02)
+ ("LOOP-VAR-" |CRYPT|::|SYMB|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|CRYPT|::|L|) |COMMON-LISP|::|NIL| 1)
+ "-" 0. |CRYPT|::|SYMB| |COMMON-LISP|::|CDR| 1. "-"
+ |COMMON-LISP|::|OR| "-")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|CRYPT|::|PREFIX| |COMMON-LISP|::|LIST|) |COMMON-LISP|::|NIL| 1)
+ #Y(|CRYPT|::|CIRC-LOOP-STOP-BODY|
+ #21Y(00 00 00 00 01 00 00 00 26 02 DB 94 02 C7 74 7B 02 61 01 19 02)
+ (|COMMON-LISP|::|NIL| |COMMON-LISP|::|NULL| #1#)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|LIST|) |COMMON-LISP|::|NIL| 1)
+ #Y(|CRYPT|::|CIRC-LOOP-SYMBOL-BODY|
+ #40Y(00 00 00 00 01 00 00 00 26 02 AD 01 02 1B 10 87 02 01 78 DB AF
+ C7 74 7B 02 7B 02 84 00 83 02 AE 8D 9F 6C AC 31 B1 19 05)
+ (|COMMON-LISP|::|NIL| |COMMON-LISP|::|CAR| #1#)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|LIST|) |COMMON-LISP|::|NIL| 1)
+ |COMMON-LISP|::|LET|
+ #Y(|CRYPT|::|CIRC-LOOP-LET-BODY|
+ #49Y(00 00 00 00 02 00 00 00 26 03 DA AE 01 02 1B 18 87 02 01 B2 DB
+ B1 6E 03 02 DD A0 5C 78 C9 5D 7A 7B 02 84 00 85 03 83 02 AE 8D
+ 9F 64 AC 31 B1 19 07)
+ (0. "-" |CRYPT|::|SYMB| |COMMON-LISP|::|COERCE|
+ ('|COMMON-LISP|::|LIST|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|CRYPT|::|PREFIX| |COMMON-LISP|::|LIST|) |COMMON-LISP|::|NIL| 1)
+ |COMMON-LISP|::|DO| |COMMON-LISP|::|SYMBOL-MACROLET|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ "Loop circularly over some sequences.\n
+binding is a list of (variable sequence).\n
+The loop is the same size of the first sequence.\n
+Each variable binding element is bound to each character in the\n
+sequence in the second element.\n
+See 'test-circ-loop for some usage examples."
+ 1)
+ (|CRYPT|::|BINDING| |COMMON-LISP|::|&BODY| |CRYPT|::|BODY|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|57 68 (DEFUN TEST-CIRC-LOOP NIL ...)-6|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CRYPT|::|TEST-CIRC-LOOP| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CRYPT|::|TEST-CIRC-LOOP|
+ #146Y(00 00 00 00 00 00 00 00 26 01 DA 38 01 31 8E DB DC 72 3B DD DC 72
+ 3B DE DC 72 3B DF DC 72 3B AF AF AF AF 93 03 2B 94 03 94 03 94 03
+ 94 03 7B 04 38 01 31 8E 95 03 A0 5C 1C 01 A4 14 A0 5C 1C 01 A4 14
+ A0 5C 1C 01 A4 FB 6A 03 6A 03 6A 03 92 03 55 16 08 E0 38 01 31 8E
+ 38 01 31 97 E1 DC 72 3B E2 DC 72 3B E3 DC 72 3B AE AE AE 93 02 21
+ E4 6B 0B 94 04 94 04 94 04 33 04 15 95 02 9F 5C 1C 01 A2 14 9F 5C
+ 1C 01 A2 FA 6A 02 6A 02 92 02 5F 00 19 07)
+ (|CRYPT|::|FIRST-TEST| "Ceci est un test. éà ç^# 1234567890"
+ |COMMON-LISP|::|LIST| "azerty" "test" "123" |CRYPT|::|SECOND-TEST|
+ #(1. 2. 3. 4. 5. 6. 7. 8. 9. 10.) (1. 2. 3.) "abcd"
+ #Y(|CRYPT|::|TEST-CIRC-LOOP-1|
+ #43Y(00 00 00 00 04 00 00 00 21 1A DA B2 31 94 B0 B2 31 90 DB B2 31
+ 94 AF B2 31 90 DB B2 31 94 AE B2 31 90 DC B2 38 02 31 95 9E 19
+ 06)
+ (#\( #\Space ") ")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|*STANDARD-OUTPUT*|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|) ()
+ |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|72 76 (DEFUN CRYPT-TO-LIST (MSG &OPTIONAL #) ...)-7|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CRYPT|::|CRYPT-TO-LIST| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CRYPT|::|CRYPT-TO-LIST|
+ #72Y(00 00 00 00 01 00 01 00 26 08 3B 01 02 C5 F9 AE 72 62 AC AF 72 D2
+ 32 AC 1F 2C DB AD B0 73 01 3A 63 1B 18 B2 AF B3 73 02 39 96 04 B4
+ 73 02 39 72 60 38 02 DC 64 71 8A 84 00 85 02 AE AE 91 01 34 62 AC
+ 31 B1 19 07 19 04)
+ (4. 0. 16.) (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|CRYPT|::|MSG| |COMMON-LISP|::|&OPTIONAL| (|CRYPT|::|SIZE| 4.))
+ |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|80 83 (DEFUN CRYPT (MSG KEY) ...)-8|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CRYPT|::|CRYPT| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CRYPT|::|CRYPT|
+ #76Y(03 00 01 00 02 00 00 00 26 03 DA 38 01 72 8F 53 30 B1 DB 72 3B B1
+ DB 72 3B AD AD 93 01 1D B2 DC 94 03 71 28 94 03 71 28 73 02 3F 2D
+ 03 03 95 01 9E 5C 1C 01 A0 F9 6A 01 92 01 63 16 04 AE 32 90 54 67
+ 00 00 00 38 01 32 97 55 19 04)
+ (|COMMON-LISP|::|CHARACTER| |COMMON-LISP|::|LIST|
+ #Y(|CRYPT|::|CRYPT-1|
+ #24Y(00 00 00 00 02 00 00 00 21 18 AF 01 02 DA DB 01 02 B5 2D 08 02
+ 9E 19 04)
+ (4. #\0 |SYSTEM|::|DO-FORMAT-HEXADECIMAL|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|FORMAT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|CRYPT|::|MSG| |CRYPT|::|KEY|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|86 89 (DEFUN DECRYPT (MSG KEY) ...)-9|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CRYPT|::|DECRYPT| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CRYPT|::|DECRYPT|
+ #77Y(03 00 01 00 02 00 00 00 26 03 DA 38 01 72 8F 53 31 B1 DB 70 02 DD
+ 72 3B B1 DD 72 3B AD AD 93 01 1B 94 01 94 01 71 28 73 02 3F 71 29
+ B3 31 90 95 01 9E 5C 1C 01 A0 F9 6A 01 92 01 65 16 04 AE 32 90 54
+ 67 00 00 00 38 01 32 97 55 19 04)
+ (|COMMON-LISP|::|CHARACTER| 4. |CRYPT|::|CRYPT-TO-LIST|
+ |COMMON-LISP|::|LIST|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|CRYPT|::|MSG| |CRYPT|::|KEY|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|91 96 (DEFUN TEST NIL ...)-10|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CRYPT|::|TEST| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CRYPT|::|TEST|
+ #50Y(00 00 00 00 00 00 00 00 26 01 38 02 72 8F AC 01 02 DA 2D 04 01 DC
+ AD 38 02 31 95 AC 81 90 00 AC DD 70 04 AC DD 70 05 E0 6B 07 B0 B0
+ B0 33 04 15 19 04)
+ (#\d |SYSTEM|::|DO-FORMAT-CHARACTER|
+ " Ceci est un test. éà ç^# 1234567890"
+ "11a3e229084349bc25d97e29393ced1d" |CRYPT|::|CRYPT| |CRYPT|::|DECRYPT|
+ #Y(|CRYPT|::|TEST-1|
+ #46Y(00 00 00 00 04 00 00 00 21 1A DA B2 38 02 31 95 B0 B2 31 90 DB
+ B2 38 02 31 95 AF B2 31 90 DC B2 38 02 31 95 AE B2 31 90 B1 31
+ 97 9E 19 06)
+ ("msg: "
+ "\n
+Crypt: "
+ "\n
+Decrypt: ")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|*STANDARD-OUTPUT*|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|) ()
+ |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|101 112 (LET* (# #) (DEFUN GENERATE-KEY # ...))-11|
+ #114Y(03 00 01 00 00 00 00 00 20 01 00 2B 02 DA 38 01 72 8F 53 3D DB 1B 16
+ AC DD 73 02 37 71 29 B0 31 90 AC DE 73 02 37 71 29 B0 31 90 85 00 AC
+ DC 91 01 34 64 16 01 DB 1B 0C AC E0 73 02 37 71 29 B0 31 90 85 00 AC
+ DF 91 01 34 6E 16 01 AE 32 90 3F 54 67 00 00 00 38 01 32 97 55 16 01
+ 0B 00 00 14 32 62 0B 00 01 E1 2F 08 E1 AD 6D 09 01 32 9C CC 19 02)
+ (|COMMON-LISP|::|CHARACTER| 0. 26. 97. 65. 10. 48. |CRYPT|::|GENERATE-KEY|
+ |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CRYPT|::|GENERATE-KEY|
+ #84Y(03 00 01 00 00 00 02 00 26 0C 3B 02 02 C6 FA 3B 01 02 C7 F9 AD AF
+ 73 01 38 38 01 72 F7 AF 73 02 37 DD 38 01 72 8F 53 21 DE 1B 12 69
+ 00 01 69 00 02 38 01 72 F7 73 01 01 B0 31 90 85 00 AC B1 91 01 34
+ 68 16 01 AE 32 90 54 67 00 00 00 38 01 32 97 55 19 05)
+ (|COMMON-LISP|::|NIL| 10. 30. |COMMON-LISP|::|CHARACTER| 0.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|&OPTIONAL| (|CRYPT|::|MIN-SIZE| 10.)
+ (|CRYPT|::|MAX-SIZE| 30.))
+ |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
Added: clfswm/contrib/server/crypt.lib
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/crypt.lib Thu Aug 12 17:30:52 2010
@@ -0,0 +1,114 @@
+#0Y_ #0Y |CHARSET|::|UTF-8|
+(|COMMON-LISP|::|SETQ| |COMMON-LISP|::|*PACKAGE*|
+ (|SYSTEM|::|%FIND-PACKAGE| "COMMON-LISP-USER"))
+(|SYSTEM|::|%IN-PACKAGE| "CRYPT" :|NICKNAMES| '|COMMON-LISP|::|NIL| :|USE|
+ '|COMMON-LISP|::|NIL| :|CASE-SENSITIVE| |COMMON-LISP|::|NIL| :|CASE-INVERTED|
+ |COMMON-LISP|::|NIL|)
+(|COMMON-LISP|::|USE-PACKAGE| '("COMMON-LISP") "CRYPT")
+(|SYSTEM|::|INTERN-EXPORT| '(#1="CRYPT" "DECRYPT" "GENERATE-KEY") #1#
+ |COMMON-LISP|::|NIL|)
+(|COMMON-LISP|::|FIND-PACKAGE| "CRYPT")
+(|COMMON-LISP|::|SETQ| |COMMON-LISP|::|*PACKAGE*|
+ (|SYSTEM|::|%FIND-PACKAGE| "CRYPT"))
+(|COMMON-LISP|::|DEFUN| |CRYPT|::|MKSTR|
+ (|COMMON-LISP|::|&REST| |CRYPT|::|ARGS|)
+ (|COMMON-LISP|::|WITH-OUTPUT-TO-STRING| (|CRYPT|::|S|)
+ (|COMMON-LISP|::|DOLIST| (|CRYPT|::|A| |CRYPT|::|ARGS|)
+ (|COMMON-LISP|::|PRINC| |CRYPT|::|A| |CRYPT|::|S|))))
+(|COMMON-LISP|::|DEFUN| |CRYPT|::|SYMB|
+ (|COMMON-LISP|::|&REST| |CRYPT|::|ARGS|)
+ (|COMMON-LISP|::|VALUES|
+ (|COMMON-LISP|::|INTERN|
+ (|COMMON-LISP|::|APPLY| #'|CRYPT|::|MKSTR| |CRYPT|::|ARGS|))))
+(|SYSTEM|::|C-DEFUN| '|CRYPT|::|MKSTR|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|&REST| |CRYPT|::|ARGS|)))
+(|SYSTEM|::|C-DEFUN| '|CRYPT|::|SYMB|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|&REST| |CRYPT|::|ARGS|)))
+(|SYSTEM|::|REMOVE-OLD-DEFINITIONS| '|CRYPT|::|CIRC-LOOP|)
+(|SYSTEM|::|%PUTD| '|CRYPT|::|CIRC-LOOP|
+ (|SYSTEM|::|MAKE-MACRO|
+ (|COMMON-LISP|::|FUNCTION| |CRYPT|::|CIRC-LOOP|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|CONS| |SYSTEM|::|<MACRO-FORM>|))
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|IGNORE| |SYSTEM|::|<ENV-ARG>|))
+ "Loop circularly over some sequences.\n
+binding is a list of (variable sequence).\n
+The loop is the same size of the first sequence.\n
+Each variable binding element is bound to each character in the\n
+sequence in the second element.\n
+See 'test-circ-loop for some usage examples."
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<MACRO-FORM>| 2. 2.
+ |COMMON-LISP|::|T|))
+ (|SYSTEM|::|MACRO-CALL-ERROR| |SYSTEM|::|<MACRO-FORM>|)
+ (|COMMON-LISP|::|LET*|
+ ((|CRYPT|::|BINDING|
+ (|COMMON-LISP|::|CADR| . #1=(|SYSTEM|::|<MACRO-FORM>|)))
+ (|CRYPT|::|BODY| (|COMMON-LISP|::|CDDR| . #1#)))
+ (|COMMON-LISP|::|BLOCK| |CRYPT|::|CIRC-LOOP|
+ (|COMMON-LISP|::|LABELS|
+ ((|CRYPT|::|LET-BODY| (|CRYPT|::|PREFIX| |COMMON-LISP|::|LIST|)
+ (|COMMON-LISP|::|LOOP| |CRYPT|::|FOR| |CRYPT|::|I| |CRYPT|::|FROM| 0.
+ |CRYPT|::|FOR| |CRYPT|::|L| |CRYPT|::|IN| |COMMON-LISP|::|LIST|
+ |CRYPT|::|COLLECT|
+ `(,(|CRYPT|::|SYMB| |CRYPT|::|PREFIX| "-" |CRYPT|::|I|)
+ (|COMMON-LISP|::|COERCE| ,(|COMMON-LISP|::|SECOND| |CRYPT|::|L|)
+ '|COMMON-LISP|::|LIST|))))
+ (|CRYPT|::|LOOP-VAR-NAME| (|CRYPT|::|L|)
+ (|CRYPT|::|SYMB| "LOOP-VAR-" (|COMMON-LISP|::|FIRST| |CRYPT|::|L|)))
+ (|CRYPT|::|DO-BODY| (|CRYPT|::|PREFIX| |COMMON-LISP|::|LIST|)
+ (|COMMON-LISP|::|CONS|
+ (|COMMON-LISP|::|LIST|
+ (|CRYPT|::|LOOP-VAR-NAME|
+ (|COMMON-LISP|::|FIRST| |COMMON-LISP|::|LIST|))
+ (|CRYPT|::|SYMB| |CRYPT|::|PREFIX| "-" 0.)
+ `(|COMMON-LISP|::|CDR|
+ ,(|CRYPT|::|LOOP-VAR-NAME|
+ (|COMMON-LISP|::|FIRST| |COMMON-LISP|::|LIST|))))
+ (|COMMON-LISP|::|LOOP| |CRYPT|::|FOR| |CRYPT|::|I| |CRYPT|::|FROM|
+ 1. |CRYPT|::|FOR| |CRYPT|::|L| |CRYPT|::|IN|
+ (|COMMON-LISP|::|CDR| |COMMON-LISP|::|LIST|) |CRYPT|::|COLLECT|
+ (|COMMON-LISP|::|LIST| (|CRYPT|::|LOOP-VAR-NAME| |CRYPT|::|L|)
+ (|CRYPT|::|SYMB| |CRYPT|::|PREFIX| "-" |CRYPT|::|I|)
+ `(|COMMON-LISP|::|OR|
+ (|COMMON-LISP|::|CDR| ,(|CRYPT|::|LOOP-VAR-NAME| |CRYPT|::|L|))
+ ,(|CRYPT|::|SYMB| |CRYPT|::|PREFIX| "-" |CRYPT|::|I|))))))
+ (|CRYPT|::|STOP-BODY| (|COMMON-LISP|::|LIST|)
+ (|COMMON-LISP|::|LIST|
+ `(|COMMON-LISP|::|NULL|
+ ,(|CRYPT|::|LOOP-VAR-NAME|
+ (|COMMON-LISP|::|FIRST| |COMMON-LISP|::|LIST|)))))
+ (|CRYPT|::|SYMBOL-BODY| (|COMMON-LISP|::|LIST|)
+ (|COMMON-LISP|::|LOOP| |CRYPT|::|FOR| |CRYPT|::|L| |CRYPT|::|IN|
+ |COMMON-LISP|::|LIST| |CRYPT|::|COLLECT|
+ `(,(|COMMON-LISP|::|FIRST| |CRYPT|::|L|)
+ (|COMMON-LISP|::|CAR|
+ ,(|CRYPT|::|LOOP-VAR-NAME| |CRYPT|::|L|))))))
+ (|COMMON-LISP|::|LET| ((|CRYPT|::|PREFIX| (|COMMON-LISP|::|GENSYM|)))
+ `(|COMMON-LISP|::|LET|
+ (,@(|CRYPT|::|LET-BODY| |CRYPT|::|PREFIX| |CRYPT|::|BINDING|))
+ (|COMMON-LISP|::|DO|
+ ,(|CRYPT|::|DO-BODY| |CRYPT|::|PREFIX| |CRYPT|::|BINDING|)
+ ,(|CRYPT|::|STOP-BODY| |CRYPT|::|BINDING|)
+ (|COMMON-LISP|::|SYMBOL-MACROLET|
+ ,(|CRYPT|::|SYMBOL-BODY| |CRYPT|::|BINDING|)
+ ,@|CRYPT|::|BODY|))))))))))
+ '(|CRYPT|::|BINDING| |COMMON-LISP|::|&BODY| |CRYPT|::|BODY|)))
+(|SYSTEM|::|C-DEFUN| '|CRYPT|::|TEST-CIRC-LOOP|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '|COMMON-LISP|::|NIL|))
+(|SYSTEM|::|C-DEFUN| '|CRYPT|::|CRYPT-TO-LIST|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|CRYPT|::|MSG| |COMMON-LISP|::|&OPTIONAL| (|CRYPT|::|SIZE| 4.))))
+(|SYSTEM|::|C-DEFUN| '|CRYPT|::|CRYPT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|CRYPT|::|MSG| |CRYPT|::|KEY|)))
+(|SYSTEM|::|C-DEFUN| '|CRYPT|::|DECRYPT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|CRYPT|::|MSG| |CRYPT|::|KEY|)))
+(|SYSTEM|::|C-DEFUN| '|CRYPT|::|TEST|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '|COMMON-LISP|::|NIL|))
+(|SYSTEM|::|C-DEFUN| '|CRYPT|::|GENERATE-KEY|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|&OPTIONAL| (|CRYPT|::|MIN-SIZE| 10.)
+ (|CRYPT|::|MAX-SIZE| 30.))))
Added: clfswm/contrib/server/crypt.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/crypt.lisp Thu Aug 12 17:30:52 2010
@@ -0,0 +1,112 @@
+(in-package :common-lisp-user)
+
+(defpackage :crypt
+ (:use :common-lisp)
+ (:export :crypt
+ :decrypt
+ :generate-key))
+
+(in-package :crypt)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun mkstr (&rest args)
+ (with-output-to-string (s)
+ (dolist (a args)
+ (princ a s))))
+
+ (defun symb (&rest args)
+ (values (intern (apply #'mkstr args)))))
+
+
+
+(defmacro circ-loop (binding &body body)
+ "Loop circularly over some sequences.
+binding is a list of (variable sequence).
+The loop is the same size of the first sequence.
+Each variable binding element is bound to each character in the
+sequence in the second element.
+See 'test-circ-loop for some usage examples."
+ (labels ((let-body (prefix list)
+ (loop for i from 0
+ for l in list
+ collect `(,(symb prefix "-" i) (coerce ,(second l) 'list))))
+ (loop-var-name (l)
+ (symb "LOOP-VAR-" (first l)))
+ (do-body (prefix list)
+ (cons (list (loop-var-name (first list))
+ (symb prefix "-" 0)
+ `(cdr ,(loop-var-name (first list))))
+ (loop for i from 1
+ for l in (cdr list)
+ collect (list (loop-var-name l)
+ (symb prefix "-" i)
+ `(or (cdr ,(loop-var-name l))
+ ,(symb prefix "-" i))))))
+ (stop-body (list)
+ (list `(null ,(loop-var-name (first list)))))
+ (symbol-body (list)
+ (loop for l in list
+ collect `(,(first l) (car ,(loop-var-name l))))))
+ (let ((prefix (gensym)))
+ `(let (,@(let-body prefix binding))
+ (do ,(do-body prefix binding)
+ ,(stop-body binding)
+ (symbol-macrolet ,(symbol-body binding)
+ , at body))))))
+
+(defun test-circ-loop ()
+ (print 'first-test)
+ (circ-loop ((m "Ceci est un test. éàç^# 1234567890")
+ (k "azerty")
+ (p "test")
+ (o "123"))
+ (print (list m k p o)))
+ (print 'second-test) (terpri)
+ (circ-loop ((a #(1 2 3 4 5 6 7 8 9 10))
+ (b '(1 2 3))
+ (c "abcd"))
+ (format t "(~A ~A ~A) " a b c)))
+
+
+
+(defun crypt-to-list (msg &optional (size 4))
+ (let ((len (length msg)))
+ (when (zerop (mod len size))
+ (loop for i from 0 below (/ len size)
+ collect (parse-integer (subseq msg (* i size) (* (1+ i) size)) :radix 16 :junk-allowed t)))))
+
+
+
+(defun crypt (msg key)
+ (with-output-to-string (str)
+ (circ-loop ((m msg) (k key))
+ (format str "~4,'0X" (logxor (char-code m) (char-code k))))))
+
+
+(defun decrypt (msg key)
+ (with-output-to-string (str)
+ (circ-loop ((m (crypt-to-list msg 4)) (k key))
+ (princ (code-char (logxor m (char-code k))) str))))
+
+(defun test ()
+ (let* ((key "11a3e229084349bc25d97e29393ced1d")
+ (msg (format nil "~C Ceci est un test. éàç^# 1234567890" (code-char 100)))
+ (crypt (crypt msg key))
+ (decrypt (decrypt crypt key)))
+ (format t "msg: ~A~%Crypt: ~A~%Decrypt: ~A~%" msg crypt decrypt)))
+
+
+
+
+(let* ((dic (with-output-to-string (str)
+ (dotimes (i 26)
+ (princ (code-char (+ i (char-code #\a))) str)
+ (princ (code-char (+ i (char-code #\A))) str))
+ (dotimes (i 10)
+ (princ (code-char (+ i (char-code #\0))) str))))
+ (dic-size (length dic)))
+ (defun generate-key (&optional (min-size 10) (max-size 30))
+ (let ((length (+ (random (- max-size min-size)) min-size)))
+ (with-output-to-string (str)
+ (dotimes (i length)
+ (princ (aref dic (random dic-size)) str))))))
Added: clfswm/contrib/server/key.fas
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/key.fas Thu Aug 12 17:30:52 2010
@@ -0,0 +1,101 @@
+(|SYSTEM|::|VERSION| '(20080430.))
+#0Y_ #0Y |CHARSET|::|UTF-8|
+#Y(#:|1 1 (IN-PACKAGE :CRYPT)-1|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA 31 F6 0F 01 19 01)
+ ("CRYPT" |COMMON-LISP|::|*PACKAGE*|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|3 5 (EXPORT '(LOAD-NEW-KEY SAVE-NEW-KEY *KEY*))-2|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA 38 01 31 E6 19 01)
+ ((|CRYPT|::|LOAD-NEW-KEY| |CRYPT|::|SAVE-NEW-KEY| |CRYPT|::|*KEY*|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|7 7 (DEFPARAMETER *KEY-FILENAME* "/tmp/.clfswm-server.key")-3|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 DB DC 31 5A C6 19 01)
+ ((|COMMON-LISP|::|SPECIAL| |CRYPT|::|*KEY-FILENAME*|)
+ |CRYPT|::|*KEY-FILENAME*| "/tmp/.clfswm-server.key")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|9 9 (DEFPARAMETER *KEY* "Automatically changed")-4|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 DB DC 31 5A C6 19 01)
+ ((|COMMON-LISP|::|SPECIAL| |CRYPT|::|*KEY*|) |CRYPT|::|*KEY*|
+ "Automatically changed")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|11 11 (DEFPARAMETER *INITIAL-KEY-PERMS* "0600")-5|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 DB DC 31 5A C6 19 01)
+ ((|COMMON-LISP|::|SPECIAL| |CRYPT|::|*INITIAL-KEY-PERMS*|)
+ |CRYPT|::|*INITIAL-KEY-PERMS*| "0600")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|12 12 (DEFPARAMETER *FINAL-KEY-PERMS* "0400")-6|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 DB DC 31 5A C6 19 01)
+ ((|COMMON-LISP|::|SPECIAL| |CRYPT|::|*FINAL-KEY-PERMS*|)
+ |CRYPT|::|*FINAL-KEY-PERMS*| "0400")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|15 48 (DEFUN USHELL-SH (FORMATTER &REST ARGS) ...)-7|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CRYPT|::|USHELL-SH| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CRYPT|::|USHELL-SH|
+ #31Y(00 00 00 00 01 00 00 00 27 17 63 6D 00 01 AC DB DC DD 99 04 63 B5
+ A6 77 02 7B 02 36 03 19 04)
+ (#Y(|CRYPT|::|USHELL-SH-URUN-PROG|
+ #40Y(00 00 00 00 01 00 00 00 E7 00 02 00 01 00 3D 02 3B 01 02 7E 01
+ AF DB DC 7B 02 C8 34 FB 99 04 B1 DF B1 DC B2 A6 9B 05 05)
+ (|COMMON-LISP|::|NIL| :|ARGS| :|WAIT|
+ #Y(|CRYPT|::|USHELL-SH-REMOVE-PLIST|
+ #52Y(00 00 00 00 01 00 00 00 27 17 01 02 1B 14 94 04 83 05 84 01
+ 94 04 83 05 84 01 B0 9E 23 70 A1 5C 5C FC B0 B0 32 A0 42 03
+ 15 16 02 F8 1C 6C AD B1 31 B0 19 05)
+ () (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|CRYPT|::|PLIST| |COMMON-LISP|::|&REST| |CRYPT|::|KEYS|)
+ "Remove the keys from the plist.\n
+Useful for re-using the &REST arg after removing some options."
+ 1)
+ |EXT|::|RUN-PROGRAM| :|ARGUMENTS|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|PROG| |COMMON-LISP|::|&REST| |CRYPT|::|OPTS|
+ |COMMON-LISP|::|&KEY| |CRYPT|::|ARGS|
+ (|CRYPT|::|WAIT| |COMMON-LISP|::|T|)
+ |COMMON-LISP|::|&ALLOW-OTHER-KEYS|)
+ "Common interface to shell. Does not return anything useful." 1)
+ "/bin/sh" :|ARGS| "-c" |COMMON-LISP|::|FORMAT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|FORMATTER| |COMMON-LISP|::|&REST| |CRYPT|::|ARGS|)
+ |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|51 62 (DEFUN SAVE-NEW-KEY NIL ...)-8|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CRYPT|::|SAVE-NEW-KEY| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CRYPT|::|SAVE-NEW-KEY|
+ #140Y(03 00 01 00 00 00 00 00 26 01 6B 00 8F 08 04 6B 00 32 09 6B 00 DB
+ 38 05 C7 FB C8 FA 72 0B 53 14 AE DE 30 05 93 02 03 14 2F 06 3E 54
+ 05 00 00 00 1D 0E 1B 06 05 00 00 00 1D 06 14 E1 64 2D 03 06 55 16
+ 01 E2 6B 09 6B 00 2D 03 0A 2E 0B 0F 0C 6B 00 DB 38 05 C7 FB C8 FA
+ 72 0B 53 17 AE E7 6B 0C 2D 03 05 93 02 03 14 2F 06 3E 54 05 00 00
+ 00 1D 0E 1B 06 05 00 00 00 1D 06 14 E1 64 2D 03 06 55 16 01 E8 6B
+ 0F 6B 00 2D 03 0A 19 01)
+ (|CRYPT|::|*KEY-FILENAME*| :|OUTPUT| :|SUPERSEDE| :|CREATE|
+ #Y(|CRYPT|::|SAVE-NEW-KEY-1|
+ #19Y(00 00 00 00 01 00 00 00 21 17 DA AF 38 02 31 95 9E 19 03)
+ ("Nothing useful\n")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|FORMAT| |COMMON-LISP|::|CLOSE| :|ABORT| "chmod ~A ~A"
+ |CRYPT|::|*INITIAL-KEY-PERMS*| |CRYPT|::|USHELL-SH|
+ |CRYPT|::|GENERATE-KEY| |CRYPT|::|*KEY*|
+ #Y(|CRYPT|::|SAVE-NEW-KEY-2|
+ #20Y(00 00 00 00 02 00 00 00 21 18 AE B0 31 90 AF 31 97 9E 19 04) ()
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ "chmod ~A ~A" |CRYPT|::|*FINAL-KEY-PERMS*|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|) ()
+ |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|64 68 (DEFUN LOAD-NEW-KEY NIL ...)-9|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|CRYPT|::|LOAD-NEW-KEY| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|CRYPT|::|LOAD-NEW-KEY|
+ #76Y(03 00 01 00 00 00 00 00 26 01 6B 00 8E 08 06 E0 6B 00 33 01 1E 6B
+ 00 DB 38 05 72 0B 53 1F C7 45 AF 01 02 38 01 31 82 0F 03 14 05 00
+ 00 02 1D 03 14 2F 04 46 54 05 00 00 00 1D 0E 1B 06 05 00 00 00 1D
+ 06 14 DF 64 2D 03 04 55 19 02)
+ (|CRYPT|::|*KEY-FILENAME*| :|INPUT| #.#'|COMMON-LISP|::|VALUES|
+ |CRYPT|::|*KEY*| |COMMON-LISP|::|CLOSE| :|ABORT|
+ "Key file ~S not found")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|) ()
+ |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
Added: clfswm/contrib/server/key.lib
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/key.lib Thu Aug 12 17:30:52 2010
@@ -0,0 +1,16 @@
+#0Y_ #0Y |CHARSET|::|UTF-8|
+(|COMMON-LISP|::|SETQ| |COMMON-LISP|::|*PACKAGE*|
+ (|SYSTEM|::|%FIND-PACKAGE| "CRYPT"))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|SPECIAL| |CRYPT|::|*KEY-FILENAME*|))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|SPECIAL| |CRYPT|::|*KEY*|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|SPECIAL| |CRYPT|::|*INITIAL-KEY-PERMS*|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|SPECIAL| |CRYPT|::|*FINAL-KEY-PERMS*|))
+(|SYSTEM|::|C-DEFUN| '|CRYPT|::|USHELL-SH|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|FORMATTER| |COMMON-LISP|::|&REST| |CRYPT|::|ARGS|)))
+(|SYSTEM|::|C-DEFUN| '|CRYPT|::|SAVE-NEW-KEY|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '|COMMON-LISP|::|NIL|))
+(|SYSTEM|::|C-DEFUN| '|CRYPT|::|LOAD-NEW-KEY|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '|COMMON-LISP|::|NIL|))
Added: clfswm/contrib/server/key.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/key.lisp Thu Aug 12 17:30:52 2010
@@ -0,0 +1,70 @@
+(in-package :crypt)
+
+(export '(load-new-key
+ save-new-key
+ *key*))
+
+(defparameter *key-filename* "/tmp/.clfswm-server.key")
+
+(defparameter *key* "Automatically changed")
+
+(defparameter *initial-key-perms* "0600")
+(defparameter *final-key-perms* "0400")
+
+
+(defun ushell-sh (formatter &rest args)
+ (labels ((remove-plist (plist &rest keys)
+ "Remove the keys from the plist.
+Useful for re-using the &REST arg after removing some options."
+ (do (copy rest)
+ ((null (setq rest (nth-value 2 (get-properties plist keys))))
+ (nreconc copy plist))
+ (do () ((eq plist rest))
+ (push (pop plist) copy)
+ (push (pop plist) copy))
+ (setq plist (cddr plist))))
+ (urun-prog (prog &rest opts &key args (wait t) &allow-other-keys)
+ "Common interface to shell. Does not return anything useful."
+ #+gcl (declare (ignore wait))
+ (setq opts (remove-plist opts :args :wait))
+ #+allegro (apply #'excl:run-shell-command (apply #'vector prog prog args)
+ :wait wait opts)
+ #+(and clisp lisp=cl)
+ (apply #'ext:run-program prog :arguments args :wait wait opts)
+ #+(and clisp (not lisp=cl))
+ (if wait
+ (apply #'lisp:run-program prog :arguments args opts)
+ (lisp:shell (format nil "~a~{ '~a'~} &" prog args)))
+ #+cmu (apply #'ext:run-program prog args :wait wait :output *standard-output* opts)
+ #+gcl (apply #'si:run-process prog args)
+ #+liquid (apply #'lcl:run-program prog args)
+ #+lispworks (apply #'sys::call-system-showing-output
+ (format nil "~a~{ '~a'~}~@[ &~]" prog args (not wait))
+ opts)
+ #+lucid (apply #'lcl:run-program prog :wait wait :arguments args opts)
+ #+sbcl (apply #'sb-ext:run-program prog args :wait wait :output *standard-output* opts)
+ #-(or allegro clisp cmu gcl liquid lispworks lucid sbcl)
+ (error 'not-implemented :proc (list 'run-prog prog opts))))
+ (urun-prog "/bin/sh" :args (list "-c" (apply #'format nil formatter args)))))
+
+
+(defun save-new-key ()
+ (when (probe-file *key-filename*)
+ (delete-file *key-filename*))
+ (with-open-file (stream *key-filename* :direction :output :if-exists :supersede
+ :if-does-not-exist :create)
+ (format stream "Nothing useful~%"))
+ (ushell-sh "chmod ~A ~A" *initial-key-perms* *key-filename*)
+ (setf *key* (generate-key))
+ (with-open-file (stream *key-filename* :direction :output :if-exists :supersede
+ :if-does-not-exist :create)
+ (format stream "~A~%" *key*))
+ (ushell-sh "chmod ~A ~A" *final-key-perms* *key-filename*))
+
+(defun load-new-key ()
+ (if (probe-file *key-filename*)
+ (with-open-file (stream *key-filename* :direction :input)
+ (setf *key* (read-line stream nil nil)))
+ (error "Key file ~S not found" *key-filename*)))
+
+
Added: clfswm/contrib/server/load.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/load.lisp Thu Aug 12 17:30:52 2010
@@ -0,0 +1,59 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: CLFSWM Client
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(defparameter *base-dir* (directory-namestring *load-truename*))
+(export '*base-dir*)
+
+#+CMU
+(setf ext:*gc-verbose* nil)
+
+#+SBCL
+(require :asdf)
+
+#+SBCL
+(require :sb-posix)
+
+#-ASDF
+(let ((asdf-file (make-pathname :host (pathname-host *base-dir*)
+ :device (pathname-device *base-dir*)
+ :directory (pathname-directory *base-dir*)
+ :name "asdf" :type "lisp")))
+ (if (probe-file asdf-file)
+ (load asdf-file)
+ (load (make-pathname :host (pathname-host *base-dir*)
+ :device (pathname-device *base-dir*)
+ :directory (butlast (pathname-directory *base-dir*))
+ :name "asdf" :type "lisp"))))
+
+(push *base-dir* asdf:*central-registry*)
+
+(asdf:oos 'asdf:load-op :clfswm-client)
+
+(in-package :clfswm-client)
+
+
+#-BUILD
+(start-client)
+
Added: clfswm/contrib/server/md5.fas
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/md5.fas Thu Aug 12 17:30:52 2010
@@ -0,0 +1,1203 @@
+(|SYSTEM|::|VERSION| '(20080430.))
+#0Y_ #0Y |CHARSET|::|UTF-8|
+#Y(#:|1 50 (DEFPACKAGE #:MD5 (:USE #:CL) ...)-1-1|
+ #18Y(00 00 00 00 00 00 00 00 20 01 DA 01 04 31 F0 3E 19 01) ("MD5")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|1 50 (DEFPACKAGE #:MD5 (:USE #:CL) ...)-1-2|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA DB 31 EC 3E 19 01)
+ (("COMMON-LISP") "MD5")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|1 50 (DEFPACKAGE #:MD5 (:USE #:CL) ...)-1-3|
+ #19Y(00 00 00 00 00 00 00 00 20 01 DA DB 63 2D 03 02 3E 19 01)
+ (("MD5-REGS" "INITIAL-MD5-REGS" "MD5REGS-DIGEST" "UPDATE-MD5-BLOCK"
+ "FILL-BLOCK" "FILL-BLOCK-UB8" "FILL-BLOCK-CHAR" "MD5-STATE" "MD5-STATE-P"
+ "MAKE-MD5-STATE" "UPDATE-MD5-STATE" "FINALIZE-MD5-STATE" "MD5SUM-SEQUENCE"
+ "MD5SUM-STREAM" "MD5SUM-FILE" "MD5")
+ "MD5" |SYSTEM|::|INTERN-EXPORT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|1 50 (DEFPACKAGE #:MD5 (:USE #:CL) ...)-1-4|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 D9 19 01) ("MD5")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+#Y(#:|52 52 (IN-PACKAGE #:MD5)-2|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA 31 F6 0F 01 19 01)
+ ("MD5" |COMMON-LISP|::|*PACKAGE*|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|54 70 (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (DEFTYPE UB32 NIL ...))-3|
+ #24Y(00 00 00 00 00 00 00 00 20 01 DA DB DC 32 A2 DA DD DE 2D 03 05 C5 19
+ 01)
+ (|MD5|::|UB32| |SYSTEM|::|DEFTYPE-EXPANDER|
+ #Y(#:|DEFTYPE-UB32|
+ #26Y(00 00 00 00 01 00 00 00 20 02 AD DA DA 2D 03 01 1D 03 C8 19 02 AD
+ 2F 02 19 02)
+ (1. |SYSTEM|::|PROPER-LIST-LENGTH-IN-BOUNDS-P|
+ |SYSTEM|::|TYPE-CALL-ERROR| (|COMMON-LISP|::|UNSIGNED-BYTE| 32.))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|TYPE|
+ "Corresponds to the 32bit quantity word of the MD5 Spec"
+ |SYSTEM|::|%SET-DOCUMENTATION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|72 81 (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (DEFMACRO ASSEMBLE-UB32 # ...))-4|
+ #23Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 72 4C 32 9C C5 19 01)
+ (|MD5|::|ASSEMBLE-UB32| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|ASSEMBLE-UB32|
+ #64Y(00 00 00 00 02 00 00 00 26 03 AE DA DA 63 2D 04 01 1D 28 9F 5C 78
+ A0 5C 5C 78 A1 5C 5C 5C 78 B1 71 A2 DD DE DF E0 B0 CC 5D 7A E0 B2
+ CD 5D 7A E0 B4 CE 5D 7A B5 7B 05 61 03 19 07 AE 2F 02 19 03)
+ (5. |SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|MACRO-CALL-ERROR|
+ |COMMON-LISP|::|THE| |MD5|::|UB32| |COMMON-LISP|::|LOGIOR|
+ |COMMON-LISP|::|ASH| (24.) (16.) (8.))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ "Assemble an ub32 value from the given (unsigned-byte 8) values,\n
+where a is the intended low-order byte and d the high-order byte."
+ 1)
+ (|MD5|::|A| |MD5|::|B| |MD5|::|C| |MD5|::|D|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|83 86 (DECLAIM (INLINE F G ...) (FTYPE # F ...))-5-1|
+ #16Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 3E 19 01)
+ ((|COMMON-LISP|::|INLINE| |MD5|::|F| |MD5|::|G| |MD5|::|H| |MD5|::|I|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|83 86 (DECLAIM (INLINE F G ...) (FTYPE # F ...))-5-2|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 19 01)
+ ((|COMMON-LISP|::|FTYPE|
+ (|COMMON-LISP|::|FUNCTION| (|MD5|::|UB32| |MD5|::|UB32| |MD5|::|UB32|)
+ |MD5|::|UB32|)
+ |MD5|::|F| |MD5|::|G| |MD5|::|H| |MD5|::|I|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|88 95 (DEFUN F (X Y Z) ...)-6|
+ #25Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 32 A2 DA DE 32 9C C5 19
+ 01)
+ (|MD5|::|F| |SYSTEM|::|REMOVE-OLD-DEFINITIONS| |SYSTEM|::|INLINE-EXPANSION|
+ ((|MD5|::|X| |MD5|::|Y| |MD5|::|Z|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|F|)
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| |MD5|::|X| |MD5|::|Y| |MD5|::|Z|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|F|
+ (|COMMON-LISP|::|LOGIOR| (|COMMON-LISP|::|LOGAND| |MD5|::|X| |MD5|::|Y|)
+ (|COMMON-LISP|::|LOGANDC1| |MD5|::|X| |MD5|::|Z|))))
+ #Y(|MD5|::|F|
+ #24Y(00 00 00 00 03 00 00 00 26 04 AF AF 73 02 40 B0 AF 72 E4 33 02 3E
+ 19 04)
+ () (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|)
+ (|MD5|::|X| |MD5|::|Y| |MD5|::|Z|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|97 104 (DEFUN G (X Y Z) ...)-7|
+ #25Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 32 A2 DA DE 32 9C C5 19
+ 01)
+ (|MD5|::|G| |SYSTEM|::|REMOVE-OLD-DEFINITIONS| |SYSTEM|::|INLINE-EXPANSION|
+ ((|MD5|::|X| |MD5|::|Y| |MD5|::|Z|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|G|)
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| |MD5|::|X| |MD5|::|Y| |MD5|::|Z|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|G|
+ (|COMMON-LISP|::|LOGIOR| (|COMMON-LISP|::|LOGAND| |MD5|::|X| |MD5|::|Z|)
+ (|COMMON-LISP|::|LOGANDC2| |MD5|::|Y| |MD5|::|Z|))))
+ #Y(|MD5|::|G|
+ #24Y(00 00 00 00 03 00 00 00 26 04 AF AE 73 02 40 AF AF 72 E5 33 02 3E
+ 19 04)
+ () (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|)
+ (|MD5|::|X| |MD5|::|Y| |MD5|::|Z|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|106 112 (DEFUN H (X Y Z) ...)-8|
+ #25Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 32 A2 DA DE 32 9C C5 19
+ 01)
+ (|MD5|::|H| |SYSTEM|::|REMOVE-OLD-DEFINITIONS| |SYSTEM|::|INLINE-EXPANSION|
+ ((|MD5|::|X| |MD5|::|Y| |MD5|::|Z|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|H|)
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| |MD5|::|X| |MD5|::|Y| |MD5|::|Z|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|H|
+ (|COMMON-LISP|::|LOGXOR| |MD5|::|X| |MD5|::|Y| |MD5|::|Z|)))
+ #Y(|MD5|::|H| #18Y(00 00 00 00 03 00 00 00 26 04 AF AF AF 33 03 3F 19 04)
+ () (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|)
+ (|MD5|::|X| |MD5|::|Y| |MD5|::|Z|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|114 120 (DEFUN I (X Y Z) ...)-9|
+ #25Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 32 A2 DA DE 32 9C C5 19
+ 01)
+ (|MD5|::|I| |SYSTEM|::|REMOVE-OLD-DEFINITIONS| |SYSTEM|::|INLINE-EXPANSION|
+ ((|MD5|::|X| |MD5|::|Y| |MD5|::|Z|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|I|)
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| |MD5|::|X| |MD5|::|Y| |MD5|::|Z|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|I|
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 32. 0.)
+ (|COMMON-LISP|::|LOGXOR| |MD5|::|Y|
+ (|COMMON-LISP|::|LOGORC2| |MD5|::|X| |MD5|::|Z|)))))
+ #Y(|MD5|::|I|
+ #23Y(00 00 00 00 03 00 00 00 26 04 DA AF B1 B0 72 E7 73 02 3F 32 F2 19
+ 04)
+ (#S(|COMMON-LISP|::|BYTE| :|SIZE| 32. :|POSITION| 0.))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|)
+ (|MD5|::|X| |MD5|::|Y| |MD5|::|Z|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|122 123 (DECLAIM (INLINE MOD32+) (FTYPE # MOD32+))-10-1|
+ #16Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 3E 19 01)
+ ((|COMMON-LISP|::|INLINE| |MD5|::|MOD32+|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|122 123 (DECLAIM (INLINE MOD32+) (FTYPE # MOD32+))-10-2|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 19 01)
+ ((|COMMON-LISP|::|FTYPE|
+ (|COMMON-LISP|::|FUNCTION| (|MD5|::|UB32| |MD5|::|UB32|) |MD5|::|UB32|)
+ |MD5|::|MOD32+|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|124 126 (DEFUN MOD32+ (A B) ...)-11|
+ #25Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 32 A2 DA DE 32 9C C5 19
+ 01)
+ (|MD5|::|MOD32+| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ |SYSTEM|::|INLINE-EXPANSION|
+ ((|MD5|::|A| |MD5|::|B|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|MOD32+|)
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| |MD5|::|A| |MD5|::|B|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MOD32+|
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 32. 0.)
+ (|COMMON-LISP|::|+| |MD5|::|A| |MD5|::|B|))))
+ #Y(|MD5|::|MOD32+|
+ #20Y(00 00 00 00 02 00 00 00 26 03 DA AF AF 73 02 37 32 F2 19 03)
+ (#S(|COMMON-LISP|::|BYTE| :|SIZE| 32. :|POSITION| 0.))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|)
+ (|MD5|::|A| |MD5|::|B|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|128 133 (DECLAIM (INLINE ROL32) (FTYPE # ROL32))-12-1|
+ #16Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 3E 19 01)
+ ((|COMMON-LISP|::|INLINE| |MD5|::|ROL32|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|128 133 (DECLAIM (INLINE ROL32) (FTYPE # ROL32))-12-2|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 19 01)
+ ((|COMMON-LISP|::|FTYPE|
+ (|COMMON-LISP|::|FUNCTION|
+ (|MD5|::|UB32| (|COMMON-LISP|::|UNSIGNED-BYTE| 5.)) |MD5|::|UB32|)
+ |MD5|::|ROL32|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|134 142 (DEFUN ROL32 (A S) ...)-13|
+ #25Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 32 A2 DA DE 32 9C C5 19
+ 01)
+ (|MD5|::|ROL32| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ |SYSTEM|::|INLINE-EXPANSION|
+ ((|MD5|::|A| |MD5|::|S|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|ROL32|)
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| |MD5|::|A|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|UNSIGNED-BYTE| 5.) |MD5|::|S|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|ROL32|
+ (|COMMON-LISP|::|LOGIOR|
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 32. 0.)
+ (|COMMON-LISP|::|ASH| |MD5|::|A| |MD5|::|S|))
+ (|COMMON-LISP|::|ASH| |MD5|::|A| (|COMMON-LISP|::|-| |MD5|::|S| 32.)))))
+ #Y(|MD5|::|ROL32|
+ #30Y(00 00 00 00 02 00 00 00 26 03 DA AF AF 72 EC 72 F2 AF DB B0 73 02
+ 37 72 EC 33 02 3E 19 03)
+ (#S(|COMMON-LISP|::|BYTE| :|SIZE| 32. :|POSITION| 0.) -32.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|)
+ (|MD5|::|A| |MD5|::|S|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|144 153 (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (DEFPARAMETER *T* #))-14|
+ #62Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 DB DC 38 07 C8 FD DE 63 1B 14 DF
+ AE E0 72 C9 72 BC 72 B9 73 02 39 38 01 72 D0 84 00 85 01 AD DC 91 01 32
+ 66 AC 31 B1 16 02 FB 71 1D 31 5A C6 19 01)
+ ((|COMMON-LISP|::|SPECIAL| |MD5|::|*T*|) |MD5|::|*T*| 64. |MD5|::|UB32| 1.
+ 4294967296. 0.0d0)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|155 166 (DEFMACRO WITH-MD5-ROUND (# &REST CLAUSES) ...)-15|
+ #23Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 72 4C 32 9C C5 19 01)
+ (|MD5|::|WITH-MD5-ROUND| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|WITH-MD5-ROUND|
+ #167Y(00 00 00 00 02 00 00 00 26 03 AE DA DA 64 2D 04 01 1D 1C 9F 5C 78
+ AC DA DA 63 2D 04 01 1D 15 AC 94 00 9E 5C 78 A3 5C 79 63 AD 01 09
+ 1B 80 6E AE 2F 02 19 03 DD DE B1 DF B0 E0 6F 07 E2 B3 E3 33 07 1F
+ AE AD 80 B8 02 1B 80 4F 87 09 0A 5B 09 08 83 0A 5B FF 83 0A 5B FE
+ 83 0A 5B FD 83 0A 5B FC 83 0A 5B FB A7 5C 5B FA E4 B5 E5 B6 E6 E5
+ E5 BB C1 BC BC BC 7B 04 7B 03 E5 E7 C1 BA 7B 03 6B 0E 97 0C 73 01
+ 01 7B 03 7B 03 B5 7B 03 7B 03 7B 03 7B 01 92 01 FF AC 9D F9 FA 16
+ 01 83 09 B5 8D 9F FF A8 E9 9E 5D 19 13)
+ (2. |SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|MACRO-CALL-ERROR|
+ |EXT|::|SOURCE-PROGRAM-ERROR| :|FORM| :|DETAIL|
+ "~S: ~S does not match lambda list element ~:S" |SYSTEM|::|TEXT|
+ |MD5|::|WITH-MD5-ROUND| #1=(|MD5|::|OP| |COMMON-LISP|::|BLOCK|)
+ |COMMON-LISP|::|SETQ| |MD5|::|MOD32+| |MD5|::|ROL32|
+ |COMMON-LISP|::|AREF| |MD5|::|*T*| |COMMON-LISP|::|PROGN|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|) |COMMON-LISP|::|NIL| 1)
+ (#1# |COMMON-LISP|::|&REST| |MD5|::|CLAUSES|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|168 173 (DEFTYPE MD5-REGS NIL ...)-16|
+ #24Y(00 00 00 00 00 00 00 00 20 01 DA DB DC 32 A2 DA DD DE 2D 03 05 C5 19
+ 01)
+ (|MD5|::|MD5-REGS| |SYSTEM|::|DEFTYPE-EXPANDER|
+ #Y(#:|DEFTYPE-MD5-REGS|
+ #26Y(00 00 00 00 01 00 00 00 20 02 AD DA DA 2D 03 01 1D 03 C8 19 02 AD
+ 2F 02 19 02)
+ (1. |SYSTEM|::|PROPER-LIST-LENGTH-IN-BOUNDS-P|
+ |SYSTEM|::|TYPE-CALL-ERROR|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 32.)
+ (4.)))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|TYPE|
+ "The working state of the MD5 algorithm, which contains the 4 32-bit\n
+registers A, B, C and D."
+ |SYSTEM|::|%SET-DOCUMENTATION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|175 176 (DEFMACRO MD5-REGS-A (REGS) ...)-17|
+ #23Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 72 4C 32 9C C5 19 01)
+ (|MD5|::|MD5-REGS-A| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|MD5-REGS-A|
+ #34Y(00 00 00 00 02 00 00 00 26 03 AE DA DA 63 2D 04 01 1D 0A 9F 5C 78
+ DD AD C9 5D 5D 19 04 AE 2F 02 19 03)
+ (2. |SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|MACRO-CALL-ERROR|
+ |COMMON-LISP|::|AREF| (0.))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|) |COMMON-LISP|::|NIL| 1)
+ (|MD5|::|REGS|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|178 179 (DEFMACRO MD5-REGS-B (REGS) ...)-18|
+ #23Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 72 4C 32 9C C5 19 01)
+ (|MD5|::|MD5-REGS-B| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|MD5-REGS-B|
+ #34Y(00 00 00 00 02 00 00 00 26 03 AE DA DA 63 2D 04 01 1D 0A 9F 5C 78
+ DD AD C9 5D 5D 19 04 AE 2F 02 19 03)
+ (2. |SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|MACRO-CALL-ERROR|
+ |COMMON-LISP|::|AREF| (1.))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|) |COMMON-LISP|::|NIL| 1)
+ (|MD5|::|REGS|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|181 182 (DEFMACRO MD5-REGS-C (REGS) ...)-19|
+ #23Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 72 4C 32 9C C5 19 01)
+ (|MD5|::|MD5-REGS-C| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|MD5-REGS-C|
+ #34Y(00 00 00 00 02 00 00 00 26 03 AE DA DA 63 2D 04 01 1D 0A 9F 5C 78
+ DD AD C9 5D 5D 19 04 AE 2F 02 19 03)
+ (2. |SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|MACRO-CALL-ERROR|
+ |COMMON-LISP|::|AREF| (2.))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|) |COMMON-LISP|::|NIL| 1)
+ (|MD5|::|REGS|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|184 185 (DEFMACRO MD5-REGS-D (REGS) ...)-20|
+ #23Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 72 4C 32 9C C5 19 01)
+ (|MD5|::|MD5-REGS-D| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|MD5-REGS-D|
+ #34Y(00 00 00 00 02 00 00 00 26 03 AE DA DA 63 2D 04 01 1D 0A 9F 5C 78
+ DD AD C9 5D 5D 19 04 AE 2F 02 19 03)
+ (2. |SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|MACRO-CALL-ERROR|
+ |COMMON-LISP|::|AREF| (3.))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|) |COMMON-LISP|::|NIL| 1)
+ (|MD5|::|REGS|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|187 188 (DEFCONSTANT +MD5-MAGIC-A+ (ASSEMBLE-UB32 1 35 ...) ...)-21|
+ #42Y(00 00 00 00 00 00 00 00 20 01 DA 38 01 8D 66 0D DB DA 71 55 8E 13 06 DA
+ DC DB 2D 03 03 DA DB 32 9D DA DE DF 2D 03 06 C5 19 01)
+ (|MD5|::|+MD5-MAGIC-A+| 1732584193.
+ (|COMMON-LISP|::|DEFCONSTANT| |MD5|::|+MD5-MAGIC-A+|
+ (|MD5|::|ASSEMBLE-UB32| 1. 35. 69. 103.)
+ #1="Initial value of Register A of the MD5 working state.")
+ |SYSTEM|::|CONSTANT-WARNING| |COMMON-LISP|::|VARIABLE| #1#
+ |SYSTEM|::|%SET-DOCUMENTATION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|189 190 (DEFCONSTANT +MD5-MAGIC-B+ (ASSEMBLE-UB32 137 171 ...) ...)-22|
+ #42Y(00 00 00 00 00 00 00 00 20 01 DA 38 01 8D 66 0D DB DA 71 55 8E 13 06 DA
+ DC DB 2D 03 03 DA DB 32 9D DA DE DF 2D 03 06 C5 19 01)
+ (|MD5|::|+MD5-MAGIC-B+| 4023233417.
+ (|COMMON-LISP|::|DEFCONSTANT| |MD5|::|+MD5-MAGIC-B+|
+ (|MD5|::|ASSEMBLE-UB32| 137. 171. 205. 239.)
+ #1="Initial value of Register B of the MD5 working state.")
+ |SYSTEM|::|CONSTANT-WARNING| |COMMON-LISP|::|VARIABLE| #1#
+ |SYSTEM|::|%SET-DOCUMENTATION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|191 192 (DEFCONSTANT +MD5-MAGIC-C+ (ASSEMBLE-UB32 254 220 ...) ...)-23|
+ #42Y(00 00 00 00 00 00 00 00 20 01 DA 38 01 8D 66 0D DB DA 71 55 8E 13 06 DA
+ DC DB 2D 03 03 DA DB 32 9D DA DE DF 2D 03 06 C5 19 01)
+ (|MD5|::|+MD5-MAGIC-C+| 2562383102.
+ (|COMMON-LISP|::|DEFCONSTANT| |MD5|::|+MD5-MAGIC-C+|
+ (|MD5|::|ASSEMBLE-UB32| 254. 220. 186. 152.)
+ #1="Initial value of Register C of the MD5 working state.")
+ |SYSTEM|::|CONSTANT-WARNING| |COMMON-LISP|::|VARIABLE| #1#
+ |SYSTEM|::|%SET-DOCUMENTATION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|193 194 (DEFCONSTANT +MD5-MAGIC-D+ (ASSEMBLE-UB32 118 84 ...) ...)-24|
+ #42Y(00 00 00 00 00 00 00 00 20 01 DA 38 01 8D 66 0D DB DA 71 55 8E 13 06 DA
+ DC DB 2D 03 03 DA DB 32 9D DA DE DF 2D 03 06 C5 19 01)
+ (|MD5|::|+MD5-MAGIC-D+| 271733878.
+ (|COMMON-LISP|::|DEFCONSTANT| |MD5|::|+MD5-MAGIC-D+|
+ (|MD5|::|ASSEMBLE-UB32| 118. 84. 50. 16.)
+ #1="Initial value of Register D of the MD5 working state.")
+ |SYSTEM|::|CONSTANT-WARNING| |COMMON-LISP|::|VARIABLE| #1#
+ |SYSTEM|::|%SET-DOCUMENTATION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|196 196 (DECLAIM (INLINE INITIAL-MD5-REGS))-25|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 19 01)
+ ((|COMMON-LISP|::|INLINE| |MD5|::|INITIAL-MD5-REGS|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|197 206 (DEFUN INITIAL-MD5-REGS NIL ...)-26|
+ #25Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 32 A2 DA DE 32 9C C5 19
+ 01)
+ (|MD5|::|INITIAL-MD5-REGS| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ |SYSTEM|::|INLINE-EXPANSION|
+ (|COMMON-LISP|::|NIL| #1="Create the initial working state of an MD5 run."
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|INITIAL-MD5-REGS|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|INITIAL-MD5-REGS|
+ (|COMMON-LISP|::|LET|
+ ((|MD5|::|REGS|
+ (|COMMON-LISP|::|MAKE-ARRAY| 4. :|ELEMENT-TYPE|
+ '#2=(|COMMON-LISP|::|UNSIGNED-BYTE| 32.))))
+ (|COMMON-LISP|::|DECLARE|
+ (|COMMON-LISP|::|TYPE| |MD5|::|MD5-REGS| |MD5|::|REGS|))
+ (|COMMON-LISP|::|SETF| (|MD5|::|MD5-REGS-A| |MD5|::|REGS|)
+ |MD5|::|+MD5-MAGIC-A+| (|MD5|::|MD5-REGS-B| |MD5|::|REGS|)
+ |MD5|::|+MD5-MAGIC-B+| (|MD5|::|MD5-REGS-C| |MD5|::|REGS|)
+ |MD5|::|+MD5-MAGIC-C+| (|MD5|::|MD5-REGS-D| |MD5|::|REGS|)
+ |MD5|::|+MD5-MAGIC-D+|)
+ |MD5|::|REGS|)))
+ #Y(|MD5|::|INITIAL-MD5-REGS|
+ #60Y(00 00 00 00 00 00 00 00 26 01 DA 38 07 C6 FD 71 1D 6B 02 AD DD AE
+ 33 01 02 16 01 6B 04 AD DF AE 33 01 02 16 01 6B 06 AD E1 AE 33 01
+ 02 16 01 6B 08 AD E3 AE 33 01 02 16 01 15 19 01)
+ (4. #2# |MD5|::|+MD5-MAGIC-A+| 0. |MD5|::|+MD5-MAGIC-B+| 1.
+ |MD5|::|+MD5-MAGIC-C+| 2. |MD5|::|+MD5-MAGIC-D+| 3.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|) () #1# 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|208 249 (DEFUN UPDATE-MD5-BLOCK (REGS BLOCK) ...)-27|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|MD5|::|UPDATE-MD5-BLOCK| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|UPDATE-MD5-BLOCK|
+ #1849Y(00 00 00 00 02 00 00 00 26 03 AE DA 73 01 01 AF DB 73 01 01 B0 DC
+ 73 01 01 B1 DD 73 01 01 AE B0 B0 B0 B0 6E 03 04 70 05 B3 DA 73 01
+ 01 E0 70 05 70 05 E1 70 08 30 05 FB 14 AD B1 B1 B1 6E 03 04 70 05
+ B3 DB 73 01 01 E3 70 05 70 05 E4 70 08 30 05 F8 14 AE AE B2 B2 6E
+ 03 04 70 05 B3 DC 73 01 01 E5 70 05 70 05 E6 70 08 30 05 F9 14 AF
+ AF AF B3 6E 03 04 70 05 B3 DD 73 01 01 E7 70 05 70 05 E8 70 08 30
+ 05 FA 14 B0 B0 B0 B0 6E 03 04 70 05 B3 E9 73 01 01 EA 70 05 70 05
+ E1 70 08 30 05 FB 14 AD B1 B1 B1 6E 03 04 70 05 B3 EB 73 01 01 EC
+ 70 05 70 05 E4 70 08 30 05 F8 14 AE AE B2 B2 6E 03 04 70 05 B3 ED
+ 73 01 01 EE 70 05 70 05 E6 70 08 30 05 F9 14 AF AF AF B3 6E 03 04
+ 70 05 B3 E1 73 01 01 EF 70 05 70 05 E8 70 08 30 05 FA 14 B0 B0 B0
+ B0 6E 03 04 70 05 B3 F0 73 01 01 F1 70 05 70 05 E1 70 08 30 05 FB
+ 14 AD B1 B1 B1 6E 03 04 70 05 B3 F2 73 01 01 F3 70 05 70 05 E4 70
+ 08 30 05 F8 14 AE AE B2 B2 6E 03 04 70 05 B3 F4 73 01 01 F5 70 05
+ 70 05 E6 70 08 30 05 F9 14 AF AF AF B3 6E 03 04 70 05 B3 F6 73 01
+ 01 F7 70 05 70 05 E8 70 08 30 05 FA 14 B0 B0 B0 B0 6E 03 04 70 05
+ B3 E4 73 01 01 65 1E 70 05 70 05 E1 70 08 30 05 FB 14 AD B1 B1 B1
+ 6E 03 04 70 05 B3 65 1F 73 01 01 65 20 70 05 70 05 E4 70 08 30 05
+ F8 14 AE AE B2 B2 6E 03 04 70 05 B3 65 21 73 01 01 65 22 70 05 70
+ 05 E6 70 08 30 05 F9 14 AF AF AF B3 6E 03 04 70 05 B3 65 23 73 01
+ 01 65 24 70 05 70 05 E8 70 08 30 05 FA 14 B0 B0 B0 B0 6E 03 25 70
+ 05 B3 DB 73 01 01 65 26 70 05 70 05 EB 70 08 30 05 FB 14 AD B1 B1
+ B1 6E 03 25 70 05 B3 ED 73 01 01 65 27 70 05 70 05 F2 70 08 30 05
+ F8 14 AE AE B2 B2 6E 03 25 70 05 B3 F6 73 01 01 65 28 70 05 70 05
+ 65 21 70 08 30 05 F9 14 AF AF AF B3 6E 03 25 70 05 B3 DA 73 01 01
+ 65 29 70 05 70 05 65 2A 70 08 30 05 FA 14 B0 B0 B0 B0 6E 03 25 70
+ 05 B3 EB 73 01 01 65 2B 70 05 70 05 EB 70 08 30 05 FB 14 AD B1 B1
+ B1 6E 03 25 70 05 B3 F4 73 01 01 65 2C 70 05 70 05 F2 70 08 30 05
+ F8 14 AE AE B2 B2 6E 03 25 70 05 B3 65 23 73 01 01 65 2D 70 05 70
+ 05 65 21 70 08 30 05 F9 14 AF AF AF B3 6E 03 25 70 05 B3 E9 73 01
+ 01 65 2E 70 05 70 05 65 2A 70 08 30 05 FA 14 B0 B0 B0 B0 6E 03 25
+ 70 05 B3 F2 73 01 01 65 2F 70 05 70 05 EB 70 08 30 05 FB 14 AD B1
+ B1 B1 6E 03 25 70 05 B3 65 21 73 01 01 65 30 70 05 70 05 F2 70 08
+ 30 05 F8 14 AE AE B2 B2 6E 03 25 70 05 B3 DD 73 01 01 65 31 70 05
+ 70 05 65 21 70 08 30 05 F9 14 AF AF AF B3 6E 03 25 70 05 B3 F0 73
+ 01 01 65 32 70 05 70 05 65 2A 70 08 30 05 FA 14 B0 B0 B0 B0 6E 03
+ 25 70 05 B3 65 1F 73 01 01 65 33 70 05 70 05 EB 70 08 30 05 FB 14
+ AD B1 B1 B1 6E 03 25 70 05 B3 DC 73 01 01 65 34 70 05 70 05 F2 70
+ 08 30 05 F8 14 AE AE B2 B2 6E 03 25 70 05 B3 E1 73 01 01 65 35 70
+ 05 70 05 65 21 70 08 30 05 F9 14 AF AF AF B3 6E 03 25 70 05 B3 E4
+ 73 01 01 65 36 70 05 70 05 65 2A 70 08 30 05 FA 14 B0 B0 B0 B0 6E
+ 03 37 70 05 B3 EB 73 01 01 65 38 70 05 70 05 E9 70 08 30 05 FB 14
+ AD B1 B1 B1 6E 03 37 70 05 B3 F0 73 01 01 65 39 70 05 70 05 F6 70
+ 08 30 05 F8 14 AE AE B2 B2 6E 03 37 70 05 B3 F6 73 01 01 65 3A 70
+ 05 70 05 65 3B 70 08 30 05 F9 14 AF AF AF B3 6E 03 37 70 05 B3 65
+ 21 73 01 01 65 3C 70 05 70 05 65 3D 70 08 30 05 FA 14 B0 B0 B0 B0
+ 6E 03 37 70 05 B3 DB 73 01 01 65 3E 70 05 70 05 E9 70 08 30 05 FB
+ 14 AD B1 B1 B1 6E 03 37 70 05 B3 E9 73 01 01 65 3F 70 05 70 05 F6
+ 70 08 30 05 F8 14 AE AE B2 B2 6E 03 37 70 05 B3 E1 73 01 01 65 40
+ 70 05 70 05 65 3B 70 08 30 05 F9 14 AF AF AF B3 6E 03 37 70 05 B3
+ F4 73 01 01 65 41 70 05 70 05 65 3D 70 08 30 05 FA 14 B0 B0 B0 B0
+ 6E 03 37 70 05 B3 65 1F 73 01 01 65 42 70 05 70 05 E9 70 08 30 05
+ FB 14 AD B1 B1 B1 6E 03 37 70 05 B3 DA 73 01 01 65 43 70 05 70 05
+ F6 70 08 30 05 F8 14 AE AE B2 B2 6E 03 37 70 05 B3 DD 73 01 01 65
+ 44 70 05 70 05 65 3B 70 08 30 05 F9 14 AF AF AF B3 6E 03 37 70 05
+ B3 ED 73 01 01 65 45 70 05 70 05 65 3D 70 08 30 05 FA 14 B0 B0 B0
+ B0 6E 03 37 70 05 B3 F2 73 01 01 65 46 70 05 70 05 E9 70 08 30 05
+ FB 14 AD B1 B1 B1 6E 03 37 70 05 B3 E4 73 01 01 65 47 70 05 70 05
+ F6 70 08 30 05 F8 14 AE AE B2 B2 6E 03 37 70 05 B3 65 23 73 01 01
+ 65 48 70 05 70 05 65 3B 70 08 30 05 F9 14 AF AF AF B3 6E 03 37 70
+ 05 B3 DC 73 01 01 65 49 70 05 70 05 65 3D 70 08 30 05 FA 14 B0 B0
+ B0 B0 6E 03 4A 70 05 B3 DA 73 01 01 65 4B 70 05 70 05 ED 70 08 30
+ 05 FB 14 AD B1 B1 B1 6E 03 4A 70 05 B3 E1 73 01 01 65 4C 70 05 70
+ 05 F4 70 08 30 05 F8 14 AE AE B2 B2 6E 03 4A 70 05 B3 65 21 73 01
+ 01 65 4D 70 05 70 05 65 23 70 08 30 05 F9 14 AF AF AF B3 6E 03 4A
+ 70 05 B3 EB 73 01 01 65 4E 70 05 70 05 65 4F 70 08 30 05 FA 14 B0
+ B0 B0 B0 6E 03 4A 70 05 B3 E4 73 01 01 65 50 70 05 70 05 ED 70 08
+ 30 05 FB 14 AD B1 B1 B1 6E 03 4A 70 05 B3 DD 73 01 01 65 51 70 05
+ 70 05 F4 70 08 30 05 F8 14 AE AE B2 B2 6E 03 4A 70 05 B3 F4 73 01
+ 01 65 52 70 05 70 05 65 23 70 08 30 05 F9 14 AF AF AF B3 6E 03 4A
+ 70 05 B3 DB 73 01 01 65 53 70 05 70 05 65 4F 70 08 30 05 FA 14 B0
+ B0 B0 B0 6E 03 4A 70 05 B3 F0 73 01 01 65 54 70 05 70 05 ED 70 08
+ 30 05 FB 14 AD B1 B1 B1 6E 03 4A 70 05 B3 65 23 73 01 01 65 55 70
+ 05 70 05 F4 70 08 30 05 F8 14 AE AE B2 B2 6E 03 4A 70 05 B3 ED 73
+ 01 01 65 56 70 05 70 05 65 23 70 08 30 05 F9 14 AF AF AF B3 6E 03
+ 4A 70 05 B3 65 1F 73 01 01 65 57 70 05 70 05 65 4F 70 08 30 05 FA
+ 14 B0 B0 B0 B0 6E 03 4A 70 05 B3 E9 73 01 01 65 58 70 05 70 05 ED
+ 70 08 30 05 FB 14 AD B1 B1 B1 6E 03 4A 70 05 B3 F6 73 01 01 65 59
+ 70 05 70 05 F4 70 08 30 05 F8 14 AE AE B2 B2 6E 03 4A 70 05 B3 DC
+ 73 01 01 65 5A 70 05 70 05 65 23 70 08 30 05 F9 14 AF AF AF B3 6E
+ 03 4A 70 05 B3 F2 73 01 01 65 5B 70 05 70 05 65 4F 70 08 30 05 FA
+ B2 DA 73 01 01 B0 70 05 B3 DA AE 33 01 02 16 01 B2 DB 73 01 01 AF
+ 70 05 B3 DB AE 33 01 02 16 01 B2 DC 73 01 01 AE 70 05 B3 DC AE 33
+ 01 02 16 01 B2 DD 73 01 01 AD 70 05 B3 DD AE 33 01 02 16 01 A3 19
+ 07)
+ (0. 1. 2. 3. |MD5|::|F| |MD5|::|MOD32+| 3614090360. 7. |MD5|::|ROL32|
+ 3905402710. 12. 606105819. 17. 3250441966. 22. 4. 4118548399. 5.
+ 1200080426. 6. 2821735955. 4249261313. 8. 1770035416. 9. 2336552879.
+ 10. 4294925233. 11. 2304563134. 1804603682. 13. 4254626195. 14.
+ 2792965006. 15. 1236535329. |MD5|::|G| 4129170786. 3225465664.
+ 643717713. 3921069994. 20. 3593408605. 38016083. 3634488961.
+ 3889429448. 568446438. 3275163606. 4107603335. 1163531501. 2850285829.
+ 4243563512. 1735328473. 2368359562. |MD5|::|H| 4294588738. 2272392833.
+ 1839030562. 16. 4259657740. 23. 2763975236. 1272893353. 4139469664.
+ 3200236656. 681279174. 3936430074. 3572445317. 76029189. 3654602809.
+ 3873151461. 530742520. 3299628645. |MD5|::|I| 4096336452. 1126891415.
+ 2878612391. 4237533241. 21. 1700485571. 2399980690. 4293915773.
+ 2240044497. 1873313359. 4264355552. 2734768916. 1309151649. 4149444226.
+ 3174756917. 718787259. 3951481745.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|MD5|::|REGS| |COMMON-LISP|::|BLOCK|)
+ "This is the core part of the MD5 algorithm. It takes a complete 16\n
+word block of input, and updates the working state in A, B, C, and D\n
+accordingly."
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|251 253 (DECLAIM (INLINE FILL-BLOCK FILL-BLOCK-UB8 ...))-28|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 19 01)
+ ((|COMMON-LISP|::|INLINE| |MD5|::|FILL-BLOCK| |MD5|::|FILL-BLOCK-UB8|
+ |MD5|::|FILL-BLOCK-CHAR|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|255 276 (DEFUN FILL-BLOCK-UB8 (BLOCK BUFFER OFFSET) ...)-29|
+ #25Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 32 A2 DA DE 32 9C C5 19
+ 01)
+ (|MD5|::|FILL-BLOCK-UB8| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ |SYSTEM|::|INLINE-EXPANSION|
+ ((|COMMON-LISP|::|BLOCK| |MD5|::|BUFFER| |MD5|::|OFFSET|)
+ #1="Convert a complete 64 (unsigned-byte 8) input vector segment\n
+starting from offset into the given 16 word MD5 block."
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|FILL-BLOCK-UB8|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|INTEGER| 0. 16777151.)
+ |MD5|::|OFFSET|)
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| |MD5|::|UB32| (16.))
+ |COMMON-LISP|::|BLOCK|)
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (|COMMON-LISP|::|*|))
+ |MD5|::|BUFFER|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|FILL-BLOCK-UB8|
+ (|COMMON-LISP|::|LOOP| |MD5|::|FOR| |MD5|::|I| |MD5|::|OF-TYPE|
+ (|COMMON-LISP|::|INTEGER| 0. 16.) |MD5|::|FROM| 0. |MD5|::|FOR|
+ |MD5|::|J| |MD5|::|OF-TYPE| (|COMMON-LISP|::|INTEGER| 0. 16777215.)
+ |MD5|::|FROM| |MD5|::|OFFSET| |MD5|::|TO|
+ (|COMMON-LISP|::|+| |MD5|::|OFFSET| 63.) |MD5|::|BY| 4.
+ |COMMON-LISP|::|DO|
+ (|COMMON-LISP|::|SETF|
+ (|COMMON-LISP|::|AREF| |COMMON-LISP|::|BLOCK| |MD5|::|I|)
+ (|MD5|::|ASSEMBLE-UB32|
+ (|COMMON-LISP|::|AREF| |MD5|::|BUFFER| |MD5|::|J|)
+ (|COMMON-LISP|::|AREF| |MD5|::|BUFFER|
+ (|COMMON-LISP|::|+| |MD5|::|J| 1.))
+ (|COMMON-LISP|::|AREF| |MD5|::|BUFFER|
+ (|COMMON-LISP|::|+| |MD5|::|J| 2.))
+ (|COMMON-LISP|::|AREF| |MD5|::|BUFFER|
+ (|COMMON-LISP|::|+| |MD5|::|J| 3.)))))))
+ #Y(|MD5|::|FILL-BLOCK-UB8|
+ #85Y(00 00 00 00 03 00 00 00 26 04 DA AE DB B0 73 02 37 1B 39 B1 DC AF
+ 73 02 37 73 01 01 DD 72 EC B2 DE B0 73 02 37 73 01 01 DF 72 EC B3
+ 96 04 73 01 01 E0 72 EC B4 B1 73 01 01 73 04 3E B3 B0 AE 33 01 02
+ 16 01 85 02 E1 AE 82 02 37 01 AD AD 91 01 32 41 00 19 07)
+ (0. 63. 3. 24. 2. 16. 8. 4.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|BLOCK| |MD5|::|BUFFER| |MD5|::|OFFSET|) #1# 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|278 299 (DEFUN FILL-BLOCK-CHAR (BLOCK BUFFER OFFSET) ...)-30|
+ #25Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 32 A2 DA DE 32 9C C5 19
+ 01)
+ (|MD5|::|FILL-BLOCK-CHAR| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ |SYSTEM|::|INLINE-EXPANSION|
+ ((|COMMON-LISP|::|BLOCK| |MD5|::|BUFFER| |MD5|::|OFFSET|)
+ #1="Convert a complete 64 character input string segment starting from\n
+offset into the given 16 word MD5 block."
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|FILL-BLOCK-CHAR|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|INTEGER| 0. 16777151.)
+ |MD5|::|OFFSET|)
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| |MD5|::|UB32| (16.))
+ |COMMON-LISP|::|BLOCK|)
+ (|COMMON-LISP|::|TYPE| |COMMON-LISP|::|SIMPLE-STRING| |MD5|::|BUFFER|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|FILL-BLOCK-CHAR|
+ (|COMMON-LISP|::|LOOP| |MD5|::|FOR| |MD5|::|I| |MD5|::|OF-TYPE|
+ (|COMMON-LISP|::|INTEGER| 0. 16.) |MD5|::|FROM| 0. |MD5|::|FOR|
+ |MD5|::|J| |MD5|::|OF-TYPE| (|COMMON-LISP|::|INTEGER| 0. 16777215.)
+ |MD5|::|FROM| |MD5|::|OFFSET| |MD5|::|TO|
+ (|COMMON-LISP|::|+| |MD5|::|OFFSET| 63.) |MD5|::|BY| 4.
+ |COMMON-LISP|::|DO|
+ (|COMMON-LISP|::|SETF|
+ (|COMMON-LISP|::|AREF| |COMMON-LISP|::|BLOCK| |MD5|::|I|)
+ (|MD5|::|ASSEMBLE-UB32|
+ (|COMMON-LISP|::|CHAR-CODE|
+ (|COMMON-LISP|::|SCHAR| |MD5|::|BUFFER| |MD5|::|J|))
+ (|COMMON-LISP|::|CHAR-CODE|
+ (|COMMON-LISP|::|SCHAR| |MD5|::|BUFFER|
+ (|COMMON-LISP|::|+| |MD5|::|J| 1.)))
+ (|COMMON-LISP|::|CHAR-CODE|
+ (|COMMON-LISP|::|SCHAR| |MD5|::|BUFFER|
+ (|COMMON-LISP|::|+| |MD5|::|J| 2.)))
+ (|COMMON-LISP|::|CHAR-CODE|
+ (|COMMON-LISP|::|SCHAR| |MD5|::|BUFFER|
+ (|COMMON-LISP|::|+| |MD5|::|J| 3.))))))))
+ #Y(|MD5|::|FILL-BLOCK-CHAR|
+ #90Y(00 00 00 00 03 00 00 00 26 04 DA AE DB B0 73 02 37 1B 3D B1 DC AF
+ 73 02 37 71 32 71 28 DD 72 EC B2 DE B0 73 02 37 71 32 71 28 DF 72
+ EC B3 96 04 71 32 71 28 E0 72 EC B4 B1 71 32 71 28 73 04 3E B3 B0
+ AE 33 01 02 16 01 85 02 E1 AE 82 02 37 01 AD AD 91 01 32 FF BC 00
+ 19 07)
+ (0. 63. 3. 24. 2. 16. 8. 4.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|BLOCK| |MD5|::|BUFFER| |MD5|::|OFFSET|) #1# 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|301 314 (DEFUN FILL-BLOCK (BLOCK BUFFER OFFSET) ...)-31|
+ #25Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 32 A2 DA DE 32 9C C5 19
+ 01)
+ (|MD5|::|FILL-BLOCK| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ |SYSTEM|::|INLINE-EXPANSION|
+ ((|COMMON-LISP|::|BLOCK| |MD5|::|BUFFER| |MD5|::|OFFSET|)
+ #1="Convert a complete 64 byte input vector segment into the given 16\n
+word MD5 block. This currently works on (unsigned-byte 8) and\n
+character simple-arrays, via the functions `fill-block-ub8' and\n
+`fill-block-char' respectively."
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|FILL-BLOCK|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|INTEGER| 0. 16777151.)
+ |MD5|::|OFFSET|)
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| |MD5|::|UB32| (16.))
+ |COMMON-LISP|::|BLOCK|)
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| |COMMON-LISP|::|*| (|COMMON-LISP|::|*|))
+ |MD5|::|BUFFER|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|FILL-BLOCK|
+ (|COMMON-LISP|::|ETYPECASE| |MD5|::|BUFFER|
+ (#2=(|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (|COMMON-LISP|::|*|))
+ (|MD5|::|FILL-BLOCK-UB8| |COMMON-LISP|::|BLOCK| |MD5|::|BUFFER|
+ |MD5|::|OFFSET|))
+ (|COMMON-LISP|::|SIMPLE-STRING|
+ (|MD5|::|FILL-BLOCK-CHAR| |COMMON-LISP|::|BLOCK| |MD5|::|BUFFER|
+ |MD5|::|OFFSET|)))))
+ #Y(|MD5|::|FILL-BLOCK|
+ #58Y(00 00 00 00 03 00 00 00 26 04 AE 8F 32 0D AE 71 06 DA 8F 14 06 AE
+ 71 07 24 01 0F AE 8E 36 13 AE DE DF 70 06 E1 2D 03 08 19 04 AF AF
+ AF 2D 03 02 19 04 AF AF AF 2D 03 03 19 04)
+ ((|COMMON-LISP|::|UNSIGNED-BYTE| 8.) 1. |MD5|::|FILL-BLOCK-UB8|
+ |MD5|::|FILL-BLOCK-CHAR| |MD5|::|BUFFER|
+ (#2# |COMMON-LISP|::|SIMPLE-STRING|) |SYSTEM|::|TYPECASE-ERROR-STRING|
+ (|COMMON-LISP|::|OR| #2# |COMMON-LISP|::|SIMPLE-STRING|)
+ |SYSTEM|::|ETYPECASE-FAILED|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|BLOCK| |MD5|::|BUFFER| |MD5|::|OFFSET|) #1# 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|316 318 (DECLAIM (INLINE MD5REGS-DIGEST))-32|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 19 01)
+ ((|COMMON-LISP|::|INLINE| |MD5|::|MD5REGS-DIGEST|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|319 339 (DEFUN MD5REGS-DIGEST (REGS) ...)-33|
+ #25Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 32 A2 DA DE 32 9C C5 19
+ 01)
+ (|MD5|::|MD5REGS-DIGEST| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ |SYSTEM|::|INLINE-EXPANSION|
+ ((|MD5|::|REGS|)
+ #1="Create the final 16 byte message-digest from the MD5 working state\n
+in regs. Returns a (simple-array (unsigned-byte 8) (16))."
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5REGS-DIGEST|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.))
+ (|COMMON-LISP|::|TYPE| |MD5|::|MD5-REGS| |MD5|::|REGS|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5REGS-DIGEST|
+ (|COMMON-LISP|::|LET|
+ ((|MD5|::|RESULT|
+ (|COMMON-LISP|::|MAKE-ARRAY| 16. :|ELEMENT-TYPE|
+ '#2=(|COMMON-LISP|::|UNSIGNED-BYTE| 8.))))
+ (|COMMON-LISP|::|DECLARE|
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (16.))
+ |MD5|::|RESULT|))
+ (|COMMON-LISP|::|MACROLET|
+ ((|MD5|::|FROB| (|MD5|::|REG| |MD5|::|OFFSET|)
+ (|COMMON-LISP|::|LET| ((|MD5|::|VAR| (|COMMON-LISP|::|GENSYM|)))
+ `(|COMMON-LISP|::|LET| ((,|MD5|::|VAR| ,|MD5|::|REG|))
+ (|COMMON-LISP|::|DECLARE|
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| ,|MD5|::|VAR|))
+ (|COMMON-LISP|::|SETF|
+ (|COMMON-LISP|::|AREF| |MD5|::|RESULT| ,|MD5|::|OFFSET|)
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 8. 0.)
+ ,|MD5|::|VAR|)
+ (|COMMON-LISP|::|AREF| |MD5|::|RESULT|
+ ,(|COMMON-LISP|::|+| |MD5|::|OFFSET| 1.))
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 8. 8.)
+ ,|MD5|::|VAR|)
+ (|COMMON-LISP|::|AREF| |MD5|::|RESULT|
+ ,(|COMMON-LISP|::|+| |MD5|::|OFFSET| 2.))
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 8. 16.)
+ ,|MD5|::|VAR|)
+ (|COMMON-LISP|::|AREF| |MD5|::|RESULT|
+ ,(|COMMON-LISP|::|+| |MD5|::|OFFSET| 3.))
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 8. 24.)
+ ,|MD5|::|VAR|))))))
+ (|MD5|::|FROB| (|MD5|::|MD5-REGS-A| |MD5|::|REGS|) 0.)
+ (|MD5|::|FROB| (|MD5|::|MD5-REGS-B| |MD5|::|REGS|) 4.)
+ (|MD5|::|FROB| (|MD5|::|MD5-REGS-C| |MD5|::|REGS|) 8.)
+ (|MD5|::|FROB| (|MD5|::|MD5-REGS-D| |MD5|::|REGS|) 12.))
+ |MD5|::|RESULT|)))
+ #Y(|MD5|::|MD5REGS-DIGEST|
+ #237Y(00 00 00 00 01 00 00 00 26 02 DA 38 07 C6 FD 71 1D AE DC 73 01 01
+ DD AD 73 02 40 AE DC AE 33 01 02 16 01 DE AD 72 F2 AE DF AE 33 01
+ 02 16 01 E0 AD 72 F2 AE E1 AE 33 01 02 16 01 E2 AD 72 F2 AE E3 AE
+ 33 01 02 16 02 AE DF 73 01 01 DD AD 73 02 40 AE E4 AE 33 01 02 16
+ 01 E5 AD 72 F2 AE E6 AE 33 01 02 16 01 E7 AD 72 F2 AE E8 AE 33 01
+ 02 16 01 E9 AD 72 F2 AE EA AE 33 01 02 16 02 AE E1 73 01 01 DD AD
+ 73 02 40 AE EB AE 33 01 02 16 01 EC AD 72 F2 AE ED AE 33 01 02 16
+ 01 EE AD 72 F2 AE EF AE 33 01 02 16 01 F0 AD 72 F2 AE F1 AE 33 01
+ 02 16 02 AE E3 73 01 01 DD AD 73 02 40 AE F2 AE 33 01 02 16 01 F3
+ AD 72 F2 AE F4 AE 33 01 02 16 01 F5 AD 72 F2 AE F6 AE 33 01 02 16
+ 01 F7 AD 72 F2 AE 65 1E AE 33 01 02 16 02 15 19 02)
+ (16. #2# 0. 255. #S(|COMMON-LISP|::|BYTE| :|SIZE| 8. :|POSITION| 8.) 1.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 8. :|POSITION| 16.) 2.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 8. :|POSITION| 24.) 3. 4.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 8. :|POSITION| 8.) 5.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 8. :|POSITION| 16.) 6.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 8. :|POSITION| 24.) 7. 8.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 8. :|POSITION| 8.) 9.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 8. :|POSITION| 16.) 10.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 8. :|POSITION| 24.) 11. 12.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 8. :|POSITION| 8.) 13.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 8. :|POSITION| 16.) 14.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 8. :|POSITION| 24.) 15.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|MD5|::|REGS|) #1# 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|341 355 (DEFSTRUCT (MD5-STATE # #) (REGS # :TYPE ...) ...)-34|
+ #802Y(00 00 00 00 00 00 00 00 20 01 00 2B 01 DA DB DC 38 01 72 9E 2F 03 5D
+ 0B 00 00 DE DF E0 DA 2F 07 DA E2 32 A3 DA 68 04 00 63 E3 E4 E5 6B 0C
+ E7 E8 E9 EA EB EC ED EE EF F0 BF 70 17 F2 F3 F4 F5 F6 64 6E 11 1D 6B
+ 0C E7 65 1E E9 65 1F EB 65 20 ED EE EF 65 21 65 21 6F 22 70 17 F2 65
+ 23 F4 65 24 F6 63 6E 11 1D 6B 0C E7 65 25 E9 65 26 EB 65 27 ED EE EF
+ 65 28 C0 70 17 F2 65 29 F4 65 2A F6 64 6E 11 1D 6B 0C E7 65 2B E9 65
+ 2C EB 65 2D ED EE EF 65 2E C0 70 17 F2 65 2F F4 65 30 F6 64 6E 11 1D
+ 6B 0C E7 65 31 E9 65 32 EB 65 33 ED EE EF 65 21 65 21 6F 22 70 17 F2
+ 65 34 F4 65 35 F6 63 6E 11 1D 6B 0C E7 65 36 E9 65 37 EB 64 ED EE EF
+ 01 02 6F 22 70 17 F2 65 38 F4 65 39 F6 63 6E 11 1D 7B 06 6B 3A E7 E8
+ E9 EA EB EC ED EE EF F0 C0 70 17 F2 65 3B 65 3C 65 3D 65 3E 63 6E 11
+ 3F 6B 3A E7 65 1E E9 65 1F EB 65 20 ED EE EF 65 21 65 21 6F 22 70 17
+ F2 65 40 65 3C 65 41 65 3E 65 42 6E 11 3F 6B 3A E7 65 25 E9 65 26 EB
+ 65 27 ED EE EF 65 28 C1 70 17 F2 65 43 65 3C 65 44 65 3E 63 6E 11 3F
+ 6B 3A E7 65 2B E9 65 2C EB 65 2D ED EE EF 65 2E C1 70 17 F2 65 45 65
+ 3C 65 46 65 3E 63 6E 11 3F 6B 3A E7 65 31 E9 65 32 EB 65 33 ED EE EF
+ 65 21 65 21 6F 22 70 17 F2 65 47 65 3C 65 48 65 3E 65 49 6E 11 3F 6B
+ 3A E7 65 36 E9 65 37 EB 64 ED EE EF 01 02 6F 22 70 17 F2 65 4A 65 3C
+ 65 4B 65 3E 65 4C 6E 11 3F 7B 06 2D 08 4D 65 4E 2F 4F 65 4E B0 6D 50
+ 01 32 9C 16 04 65 51 31 62 E5 2F 4F E5 65 52 65 53 32 A2 E5 65 54 32
+ 9C 65 55 31 62 E4 2F 4F E4 65 52 65 56 32 A2 E4 65 57 32 9C 65 58 31
+ 62 65 59 31 62 65 5A 2F 4F 65 5A 65 52 65 5B 32 A2 65 5A 65 5C 32 9C
+ 65 5A 65 5D DA 32 A2 65 5E 31 62 65 5F 31 62 65 60 2F 4F 65 60 65 52
+ 65 61 32 A2 65 60 65 62 32 9C 65 60 65 5D DA 32 A2 65 63 31 62 65 64
+ 31 62 65 65 2F 4F 65 65 65 52 65 66 32 A2 65 65 65 67 32 9C 65 65 65
+ 5D DA 32 A2 65 68 31 62 65 69 31 62 65 6A 2F 4F 65 6A 65 52 65 6B 32
+ A2 65 6A 65 6C 32 9C 65 6A 65 5D DA 32 A2 65 6D 31 62 65 6E 31 62 65
+ 6F 2F 4F 65 6F 65 52 65 70 32 A2 65 6F 65 71 32 9C 65 6F 65 5D DA 32
+ A2 65 72 31 62 65 73 31 62 65 74 2F 4F 65 74 65 52 65 75 32 A2 65 74
+ 65 76 32 9C 65 74 65 5D DA 32 A2 65 77 31 62 65 78 31 62 65 79 2F 4F
+ 65 79 65 52 65 7A 32 A2 65 79 65 7B 32 9C 65 60 65 7C DA 32 A2 65 7D
+ 31 62 65 7E 31 62 65 7F 2F 4F 65 7F 65 52 65 80 80 32 A2 65 7F 65 80
+ 81 32 9C 65 6F 65 7C DA 32 A2 65 80 82 31 62 65 80 83 31 62 65 80 84
+ 2F 4F 65 80 84 65 52 65 80 85 32 A2 65 80 84 65 80 86 32 9C 65 74 65
+ 7C DA 32 A2 DA 65 80 87 63 2D 03 80 88 DA 2F 80 89 C5 19 01)
+ (|MD5|::|MD5-STATE| |COMMON-LISP|::|STRUCTURE-OBJECT| |CLOS|::|CLOSCLASS|
+ |CLOS|::|CLASS-NAMES|
+ #Y(|MD5|::|DEFAULT-REGS| #14Y(00 00 00 00 00 00 00 00 26 01 2E 00 19 01)
+ (|MD5|::|INITIAL-MD5-REGS|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|) ()
+ |COMMON-LISP|::|NIL| 1)
+ #Y(|MD5|::|DEFAULT-BLOCK|
+ #19Y(00 00 00 00 00 00 00 00 26 01 DA 38 07 C6 FD 31 1D 19 01)
+ (16. #1=(|COMMON-LISP|::|UNSIGNED-BYTE| 32.))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|) ()
+ |COMMON-LISP|::|NIL| 1)
+ #Y(|MD5|::|DEFAULT-BUFFER|
+ #19Y(00 00 00 00 00 00 00 00 26 01 DA 38 07 C6 FD 31 1D 19 01)
+ (64. #2=(|COMMON-LISP|::|UNSIGNED-BYTE| 8.))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|) ()
+ |COMMON-LISP|::|NIL| 1)
+ |SYSTEM|::|STRUCTURE-UNDEFINE-ACCESSORIES|
+ |SYSTEM|::|DEFSTRUCT-DESCRIPTION| (|MD5|::|MAKE-MD5-STATE|)
+ |MD5|::|COPY-MD5-STATE| |MD5|::|MD5-STATE-P|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME| |MD5|::|REGS|
+ :|INITARGS| (:|REGS|) :|TYPE| |MD5|::|MD5-REGS| :|ALLOCATION| :|INSTANCE|
+ |CLOS|::|INHERITABLE-INITER| #3=(|MD5|::|INITIAL-MD5-REGS|)
+ |CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| |CLOS|::|INHERITABLE-DOC|
+ (|COMMON-LISP|::|NIL|) |CLOS|::|LOCATION| 1. |CLOS|::|READONLY|
+ |CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |MD5|::|AMOUNT| (:|AMOUNT|)
+ #4=(|COMMON-LISP|::|INTEGER| 0. |COMMON-LISP|::|*|) 0.
+ |SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| (|COMMON-LISP|::|NIL|) 2.
+ |COMMON-LISP|::|BLOCK| (:|BLOCK|)
+ #5=(|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 32.)
+ (16.))
+ #6=(|COMMON-LISP|::|MAKE-ARRAY| 16. :|ELEMENT-TYPE| '#1#)
+ (|COMMON-LISP|::|NIL|) 3. |MD5|::|BUFFER| (:|BUFFER|)
+ #7=(|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (64.))
+ #8=(|COMMON-LISP|::|MAKE-ARRAY| 64. :|ELEMENT-TYPE| '#2#)
+ (|COMMON-LISP|::|NIL|) 4. |MD5|::|BUFFER-INDEX| (:|BUFFER-INDEX|)
+ #9=(|COMMON-LISP|::|INTEGER| 0. 63.) (|COMMON-LISP|::|NIL|) 5.
+ |MD5|::|FINALIZED-P| (:|FINALIZED-P|) (|COMMON-LISP|::|NIL|) 6.
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| (|COMMON-LISP|::|NIL|)
+ :|READERS| (|MD5|::|MD5-STATE-REGS|) :|WRITERS|
+ |CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ (|COMMON-LISP|::|NIL|) (|MD5|::|MD5-STATE-AMOUNT|)
+ ((|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-AMOUNT|)) (|COMMON-LISP|::|NIL|)
+ (|MD5|::|MD5-STATE-BLOCK|) (|COMMON-LISP|::|NIL|)
+ (|MD5|::|MD5-STATE-BUFFER|) (|COMMON-LISP|::|NIL|)
+ (|MD5|::|MD5-STATE-BUFFER-INDEX|)
+ ((|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-BUFFER-INDEX|))
+ (|COMMON-LISP|::|NIL|) (|MD5|::|MD5-STATE-FINALIZED-P|)
+ ((|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-FINALIZED-P|))
+ |CLOS|::|DEFINE-STRUCTURE-CLASS| |MD5|::|MAKE-MD5-STATE|
+ |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|MAKE-MD5-STATE|
+ #72Y(00 00 00 00 00 00 00 00 26 01 2E 01 14 DC 38 07 C8 FD 71 1D DE 38
+ 07 CA FD 71 1D 69 00 01 E0 72 45 E1 AD E2 B2 32 44 E1 AD E3 E4 32
+ 44 E1 AD E5 B1 32 44 E1 AD E6 B0 32 44 E1 AD E7 E4 32 44 E1 AD E8
+ 63 32 44 15 19 04)
+ (|COMMON-LISP|::|NIL| |MD5|::|INITIAL-MD5-REGS| 16. #1# 64. #2# 7.
+ |MD5|::|MD5-STATE| 1. 2. 0. 3. 4. 5. 6.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|&AUX| (|MD5|::|REGS| #3#) (|MD5|::|AMOUNT| 0.)
+ (|COMMON-LISP|::|BLOCK| #6#) (|MD5|::|BUFFER| #8#)
+ (|MD5|::|BUFFER-INDEX| 0.) (|MD5|::|FINALIZED-P| |COMMON-LISP|::|NIL|))
+ |COMMON-LISP|::|NIL| 1)
+ (|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-P|) |SYSTEM|::|INLINE-EXPANSION|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-P|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-P|
+ (|SYSTEM|::|%STRUCTURE-TYPE-P| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT|)))
+ #Y(|MD5|::|MD5-STATE-P|
+ #16Y(00 00 00 00 01 00 00 00 20 02 DA AE 32 47 19 02)
+ (|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|INLINE| |MD5|::|COPY-MD5-STATE|)
+ ((|COMMON-LISP|::|STRUCTURE|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|COPY-MD5-STATE|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|COPY-MD5-STATE|
+ (|COMMON-LISP|::|COPY-STRUCTURE| |COMMON-LISP|::|STRUCTURE|)))
+ #Y(|MD5|::|COPY-MD5-STATE|
+ #15Y(00 00 00 00 01 00 00 00 26 02 AD 32 46 19 02) ()
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|STRUCTURE|) |COMMON-LISP|::|NIL| 1)
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-REGS| (|MD5|::|MD5-STATE|)
+ |MD5|::|MD5-REGS|)
+ (|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-REGS|) |MD5|::|MD5-STATE-REGS|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-REGS|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-REGS|
+ (|COMMON-LISP|::|THE| |MD5|::|MD5-REGS|
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT|
+ 1.))))
+ #Y(|MD5|::|MD5-STATE-REGS|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|MD5|::|MD5-STATE| 1.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ |SYSTEM|::|DEFSTRUCT-READER|
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-AMOUNT| (|MD5|::|MD5-STATE|)
+ #4#)
+ (|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-AMOUNT|)
+ |MD5|::|MD5-STATE-AMOUNT|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-AMOUNT|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-AMOUNT|
+ (|COMMON-LISP|::|THE| #4#
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT|
+ 2.))))
+ #Y(|MD5|::|MD5-STATE-AMOUNT|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|MD5|::|MD5-STATE| 2.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-BLOCK| (|MD5|::|MD5-STATE|)
+ #5#)
+ (|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-BLOCK|) |MD5|::|MD5-STATE-BLOCK|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-BLOCK|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-BLOCK|
+ (|COMMON-LISP|::|THE| #5#
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT|
+ 3.))))
+ #Y(|MD5|::|MD5-STATE-BLOCK|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|MD5|::|MD5-STATE| 3.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-BUFFER| (|MD5|::|MD5-STATE|)
+ #7#)
+ (|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-BUFFER|)
+ |MD5|::|MD5-STATE-BUFFER|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-BUFFER|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-BUFFER|
+ (|COMMON-LISP|::|THE| #7#
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT|
+ 4.))))
+ #Y(|MD5|::|MD5-STATE-BUFFER|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|MD5|::|MD5-STATE| 4.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-BUFFER-INDEX|
+ (|MD5|::|MD5-STATE|) #9#)
+ (|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-BUFFER-INDEX|)
+ |MD5|::|MD5-STATE-BUFFER-INDEX|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-BUFFER-INDEX|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-BUFFER-INDEX|
+ (|COMMON-LISP|::|THE| #9#
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT|
+ 5.))))
+ #Y(|MD5|::|MD5-STATE-BUFFER-INDEX|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|MD5|::|MD5-STATE| 5.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-FINALIZED-P|
+ (|MD5|::|MD5-STATE|) |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-FINALIZED-P|)
+ |MD5|::|MD5-STATE-FINALIZED-P|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-FINALIZED-P|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-FINALIZED-P|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|T|
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT|
+ 6.))))
+ #Y(|MD5|::|MD5-STATE-FINALIZED-P|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|MD5|::|MD5-STATE| 6.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-AMOUNT|) (#4# |MD5|::|MD5-STATE|)
+ #4#)
+ (|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-AMOUNT|))
+ #.(|SYSTEM|::|GET-SETF-SYMBOL| '|MD5|::|MD5-STATE-AMOUNT|)
+ ((|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN|
+ #10=(|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-AMOUNT|)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-AMOUNT|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 2.
+ (|COMMON-LISP|::|THE| #4# . #11=(|SYSTEM|::|VALUE|)))))
+ #Y(#10# #18Y(00 00 00 00 02 00 00 00 20 03 DA AE DB B1 32 44 19 03)
+ (|MD5|::|MD5-STATE| 2.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |SYSTEM|::|DEFSTRUCT-WRITER|
+ (|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-BUFFER-INDEX|)
+ (#9# |MD5|::|MD5-STATE|) #9#)
+ (|COMMON-LISP|::|INLINE|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-BUFFER-INDEX|))
+ #.(|SYSTEM|::|GET-SETF-SYMBOL| '|MD5|::|MD5-STATE-BUFFER-INDEX|)
+ ((|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN|
+ #12=(|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-BUFFER-INDEX|)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-BUFFER-INDEX|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 5.
+ (|COMMON-LISP|::|THE| #9# . #11#))))
+ #Y(#12# #18Y(00 00 00 00 02 00 00 00 20 03 DA AE DB B1 32 44 19 03)
+ (|MD5|::|MD5-STATE| 5.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ (|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-FINALIZED-P|)
+ (|COMMON-LISP|::|T| |MD5|::|MD5-STATE|) |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|INLINE|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-FINALIZED-P|))
+ #.(|SYSTEM|::|GET-SETF-SYMBOL| '|MD5|::|MD5-STATE-FINALIZED-P|)
+ ((|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN|
+ #13=(|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-FINALIZED-P|)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-FINALIZED-P|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 6.
+ |SYSTEM|::|VALUE|)))
+ #Y(#13# #18Y(00 00 00 00 02 00 00 00 20 03 DA AE DB B1 32 44 19 03)
+ (|MD5|::|MD5-STATE| 6.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|TYPE| |SYSTEM|::|%SET-DOCUMENTATION|
+ |CLOS|::|DEFSTRUCT-REMOVE-PRINT-OBJECT-METHOD|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|357 357 (DECLAIM (INLINE COPY-TO-BUFFER))-35|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 19 01)
+ ((|COMMON-LISP|::|INLINE| |MD5|::|COPY-TO-BUFFER|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|358 389 (DEFUN COPY-TO-BUFFER (FROM FROM-OFFSET COUNT ...) ...)-36|
+ #25Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 32 A2 DA DE 32 9C C5 19
+ 01)
+ (|MD5|::|COPY-TO-BUFFER| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ |SYSTEM|::|INLINE-EXPANSION|
+ ((|MD5|::|FROM| |MD5|::|FROM-OFFSET| |COMMON-LISP|::|COUNT| |MD5|::|BUFFER|
+ |MD5|::|BUFFER-OFFSET|)
+ #1="Copy a partial segment from input vector from starting at\n
+from-offset and copying count elements into the 64 byte buffer\n
+starting at buffer-offset."
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|COPY-TO-BUFFER|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.))
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|UNSIGNED-BYTE| 29.)
+ |MD5|::|FROM-OFFSET|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|INTEGER| 0. 63.)
+ |COMMON-LISP|::|COUNT| |MD5|::|BUFFER-OFFSET|)
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| |COMMON-LISP|::|*| (|COMMON-LISP|::|*|))
+ |MD5|::|FROM|)
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (64.))
+ |MD5|::|BUFFER|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|COPY-TO-BUFFER|
+ (|COMMON-LISP|::|ETYPECASE| |MD5|::|FROM|
+ (|COMMON-LISP|::|SIMPLE-STRING|
+ (|COMMON-LISP|::|LOOP| |MD5|::|FOR| |MD5|::|BUFFER-INDEX|
+ |MD5|::|OF-TYPE| (|COMMON-LISP|::|INTEGER| 0. 64.) |MD5|::|FROM|
+ |MD5|::|BUFFER-OFFSET| |MD5|::|FOR| |MD5|::|FROM-INDEX|
+ |MD5|::|OF-TYPE| |COMMON-LISP|::|FIXNUM| |MD5|::|FROM|
+ |MD5|::|FROM-OFFSET| |MD5|::|BELOW|
+ (|COMMON-LISP|::|+| |MD5|::|FROM-OFFSET| |COMMON-LISP|::|COUNT|)
+ |COMMON-LISP|::|DO|
+ (|COMMON-LISP|::|SETF|
+ (|COMMON-LISP|::|AREF| |MD5|::|BUFFER| |MD5|::|BUFFER-INDEX|)
+ (|COMMON-LISP|::|CHAR-CODE|
+ (|COMMON-LISP|::|SCHAR|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING| |MD5|::|FROM|)
+ |MD5|::|FROM-INDEX|)))))
+ (#2=(|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (|COMMON-LISP|::|*|))
+ (|COMMON-LISP|::|LOOP| |MD5|::|FOR| |MD5|::|BUFFER-INDEX|
+ |MD5|::|OF-TYPE| (|COMMON-LISP|::|INTEGER| 0. 64.) |MD5|::|FROM|
+ |MD5|::|BUFFER-OFFSET| |MD5|::|FOR| |MD5|::|FROM-INDEX|
+ |MD5|::|OF-TYPE| |COMMON-LISP|::|FIXNUM| |MD5|::|FROM|
+ |MD5|::|FROM-OFFSET| |MD5|::|BELOW|
+ (|COMMON-LISP|::|+| |MD5|::|FROM-OFFSET| |COMMON-LISP|::|COUNT|)
+ |COMMON-LISP|::|DO|
+ (|COMMON-LISP|::|SETF|
+ (|COMMON-LISP|::|AREF| |MD5|::|BUFFER| |MD5|::|BUFFER-INDEX|)
+ (|COMMON-LISP|::|AREF|
+ (|COMMON-LISP|::|THE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (|COMMON-LISP|::|*|))
+ |MD5|::|FROM|)
+ |MD5|::|FROM-INDEX|)))))))
+ #Y(|MD5|::|COPY-TO-BUFFER|
+ #110Y(00 00 00 00 05 00 00 00 26 06 B1 8E 36 1C B1 8F 32 0D B1 71 06 DA
+ 8F 14 06 B1 71 07 24 01 2C B1 DC DD 70 04 DF 2D 03 06 19 06 AD B1
+ B2 B2 73 02 37 AD AD 90 01 34 34 B4 AE 71 32 71 28 B2 B0 AE 33 01
+ 02 16 01 85 02 85 01 1B 66 AD B1 B2 B2 73 02 37 1B 11 B4 AE 73 01
+ 01 B2 B0 AE 33 01 02 16 01 85 02 85 01 AD AD 91 01 34 69 00 19 09)
+ ((|COMMON-LISP|::|UNSIGNED-BYTE| 8.) 1. |MD5|::|FROM|
+ (|COMMON-LISP|::|SIMPLE-STRING| #2#) |SYSTEM|::|TYPECASE-ERROR-STRING|
+ (|COMMON-LISP|::|OR| |COMMON-LISP|::|SIMPLE-STRING| #2#)
+ |SYSTEM|::|ETYPECASE-FAILED|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|MD5|::|FROM| |MD5|::|FROM-OFFSET| |COMMON-LISP|::|COUNT|
+ |MD5|::|BUFFER| |MD5|::|BUFFER-OFFSET|)
+ #1# 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|391 465 (DEFUN UPDATE-MD5-STATE (STATE SEQUENCE &KEY ...) ...)-37|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|MD5|::|UPDATE-MD5-STATE| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|UPDATE-MD5-STATE|
+ #324Y(00 00 00 00 02 00 00 00 A6 1D 02 00 00 00 3B 02 02 C7 FA 3B 01 04
+ AF 81 62 01 DD B1 DE 72 43 DD B2 DF 72 43 DD B3 E0 72 43 DD B4 E1
+ 72 43 8E AC 80 4C DD B4 E1 72 43 E2 AD 73 01 38 B2 B4 73 01 38 AD
+ AD 73 01 36 B6 B6 AE B3 B3 2D 05 09 DD B8 E4 72 43 AD 73 02 37 DD
+ B9 E4 AF 32 44 16 01 B5 AD 82 02 37 09 AD AF 90 01 31 80 4F B1 B1
+ DC 2D 03 0B B2 B2 30 0C DD B8 E1 DC 32 44 16 04 B1 B1 90 01 34 34
+ B2 8F 32 0D B2 71 06 E7 8F 14 06 B2 71 07 24 04 36 B2 8E 36 80 6A
+ B2 E9 EA 70 11 EC 2D 03 13 DD B4 E4 72 43 B1 B3 73 01 38 73 02 37
+ DD B5 E4 AF 32 44 16 01 A4 19 08 AF AD 73 02 37 DD B9 E1 AF 32 44
+ 16 05 1B FF B3 B1 1B 10 AE B4 AE 2D 03 0B AF AF 30 0C E2 AD 82 02
+ 37 00 AC B2 90 01 34 0A B1 AD 73 01 38 E2 91 01 31 60 B1 AD 73 01
+ 38 AC 8E AC 08 B4 AE AE B1 DC 2D 05 09 DD B6 CC 1B 37 B1 1B 10 AE
+ B4 AE 2D 03 0E AF AF 30 0C E2 AD 82 02 37 00 AC B2 90 01 34 0A B1
+ AD 73 01 38 E2 91 01 31 60 B1 AD 73 01 38 AC 8E AC 08 B4 AE AE B1
+ DC 2D 05 09 DD B6 CC 14 AF 32 44 16 02 1B FF 5F)
+ (:|START| :|END| 0. |MD5|::|MD5-STATE| 1. 3. 4. 5. 64.
+ |MD5|::|COPY-TO-BUFFER| 2. |MD5|::|FILL-BLOCK-UB8|
+ |MD5|::|UPDATE-MD5-BLOCK| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ |MD5|::|FILL-BLOCK-CHAR| |COMMON-LISP|::|SEQUENCE|
+ (#1=(|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (|COMMON-LISP|::|*|))
+ |COMMON-LISP|::|SIMPLE-STRING|)
+ |SYSTEM|::|TYPECASE-ERROR-STRING|
+ (|COMMON-LISP|::|OR| #1# |COMMON-LISP|::|SIMPLE-STRING|)
+ |SYSTEM|::|ETYPECASE-FAILED|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|MD5|::|STATE| |COMMON-LISP|::|SEQUENCE| |COMMON-LISP|::|&KEY|
+ (|MD5|::|START| 0.)
+ (|MD5|::|END| (|COMMON-LISP|::|LENGTH| |COMMON-LISP|::|SEQUENCE|)))
+ "Update the given md5-state from sequence, which is either a\n
+simple-string or a simple-array with element-type (unsigned-byte 8),\n
+bounded by start and end, which must be numeric bounding-indices."
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|467 510 (DEFUN FINALIZE-MD5-STATE (STATE) ...)-38|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|MD5|::|FINALIZE-MD5-STATE| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|FINALIZE-MD5-STATE|
+ #149Y(00 00 00 00 01 00 00 00 26 02 DA AE DB 32 43 1E 80 81 DA AE DC 72
+ 43 DA AF DD 72 43 DA B0 DE 72 43 DA B1 DF 72 43 E0 DA B3 E1 72 43
+ 73 02 39 AE AE E2 33 01 02 96 01 1B 08 AF AD E4 33 01 02 85 00 AC
+ E3 91 01 34 72 16 01 AF AF E4 2D 03 0B AD E6 91 01 34 17 B0 B0 30
+ 0D E4 1B 08 B0 AD E4 33 01 02 85 00 AC E8 91 01 34 72 16 01 E9 AD
+ 72 F2 B0 EA AE 33 01 02 16 01 EB AD 72 F2 B0 EC AE 33 01 02 16 01
+ B0 B0 30 0D B0 6F 13 DA B4 DB AF 32 44 19 08 19 02)
+ (|MD5|::|MD5-STATE| 6. 1. 3. 4. 5. 8. 2. 128. 64. 0.
+ |MD5|::|FILL-BLOCK-UB8| 56. |MD5|::|UPDATE-MD5-BLOCK| 16.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 32. :|POSITION| 0.) 14.
+ #S(|COMMON-LISP|::|BYTE| :|SIZE| 32. :|POSITION| 32.) 15.
+ |MD5|::|MD5REGS-DIGEST|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|MD5|::|STATE|)
+ "If the given md5-state has not already been finalized, finalize it,\n
+by processing any remaining input in its buffer, with suitable padding\n
+and appended bit-length, as specified by the MD5 standard.\n\n
+The resulting MD5 message-digest is returned as an array of sixteen\n
+(unsigned-byte 8) values. Calling `update-md5-state' after a call to\n
+`finalize-md5-state' results in unspecified behaviour."
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|512 530 (DEFUN MD5SUM-SEQUENCE (SEQUENCE &KEY # ...) ...)-39|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|MD5|::|MD5SUM-SEQUENCE| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|MD5SUM-SEQUENCE|
+ #47Y(00 00 00 00 01 00 00 00 A6 1C 02 00 00 00 3B 02 02 C7 FA 3D 01 2E
+ 03 14 92 02 03 B0 32 62 14 AD B2 DA B3 DB B1 2D 06 04 16 01 AC 2F
+ 05 19 05)
+ (:|START| :|END| 0. |MD5|::|MAKE-MD5-STATE| |MD5|::|UPDATE-MD5-STATE|
+ |MD5|::|FINALIZE-MD5-STATE|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|SEQUENCE| |COMMON-LISP|::|&KEY| (|MD5|::|START| 0.)
+ |MD5|::|END|)
+ "Calculate the MD5 message-digest of data in sequence. On CMU CL\n
+this works for all sequences whose element-type is supported by the\n
+underlying MD5 routines, on other implementations it only works for 1d\n
+simple-arrays with such element types."
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|532 535 (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (DEFCONSTANT +BUFFER-SIZE+ # ...))-40|
+ #42Y(00 00 00 00 00 00 00 00 20 01 DA 38 01 8D 66 0D DB DA 71 55 8E 13 06 DA
+ DC DB 2D 03 03 DA DB 32 9D DA DE DF 2D 03 06 C5 19 01)
+ (|MD5|::|+BUFFER-SIZE+| 131072.
+ (|COMMON-LISP|::|DEFCONSTANT| |MD5|::|+BUFFER-SIZE+|
+ (|COMMON-LISP|::|*| 128. 1024.)
+ #1="Size of internal buffer to use for md5sum-stream and md5sum-file\n
+operations. This should be a multiple of 64, the MD5 block size.")
+ |SYSTEM|::|CONSTANT-WARNING| |COMMON-LISP|::|VARIABLE| #1#
+ |SYSTEM|::|%SET-DOCUMENTATION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|537 537 (DEFTYPE BUFFER-INDEX NIL ...)-41|
+ #24Y(00 00 00 00 00 00 00 00 20 01 DA DB DC 32 A2 DA DD 63 2D 03 04 C5 19
+ 01)
+ (|MD5|::|BUFFER-INDEX| |SYSTEM|::|DEFTYPE-EXPANDER|
+ #Y(#:|DEFTYPE-BUFFER-INDEX|
+ #26Y(00 00 00 00 01 00 00 00 20 02 AD DA DA 2D 03 01 1D 03 C8 19 02 AD
+ 2F 02 19 02)
+ (1. |SYSTEM|::|PROPER-LIST-LENGTH-IN-BOUNDS-P|
+ |SYSTEM|::|TYPE-CALL-ERROR| (|COMMON-LISP|::|INTEGER| 0. 131072.))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|TYPE| |SYSTEM|::|%SET-DOCUMENTATION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|539 566 (DEFUN MD5SUM-STREAM (STREAM) ...)-42|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|MD5|::|MD5SUM-STREAM| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|MD5SUM-STREAM|
+ #95Y(00 00 00 00 01 00 00 00 26 02 2E 00 14 AE 6F 01 DC 8E 14 25 AE 6F
+ 01 25 0A 3D 6B 03 38 02 71 49 DF AD B1 30 06 F8 AE AE E1 AF 2D 04
+ 08 AC 6B 03 91 01 31 6D AE 2F 09 19 05 6B 03 38 07 C9 FD 71 1D DF
+ AD B1 30 06 F8 AE AE E1 AF 2D 04 08 AC 6B 03 91 01 31 6D 1B 5D E5
+ AF 6F 01 B0 33 02 1E)
+ (|MD5|::|MAKE-MD5-STATE| |COMMON-LISP|::|STREAM-ELEMENT-TYPE|
+ (|COMMON-LISP|::|UNSIGNED-BYTE| 8.) |MD5|::|+BUFFER-SIZE+|
+ (|COMMON-LISP|::|UNSIGNED-BYTE| 8.) 0. |COMMON-LISP|::|READ-SEQUENCE|
+ :|END| |MD5|::|UPDATE-MD5-STATE| |MD5|::|FINALIZE-MD5-STATE|
+ |COMMON-LISP|::|CHARACTER|
+ "Unsupported stream element-type ~S for stream ~S.")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|STREAM|)
+ "Calculate an MD5 message-digest of the contents of stream. Its\n
+element-type has to be either (unsigned-byte 8) or character."
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|568 572 (DEFUN MD5SUM-FILE (PATHNAME) ...)-43|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|MD5|::|MD5SUM-FILE| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|MD5SUM-FILE|
+ #59Y(03 00 01 00 01 00 00 00 26 02 AD 38 06 C5 FC 72 0B 53 19 C6 45 AF
+ 2F 02 41 05 00 00 02 1D 03 14 2F 03 46 54 05 00 00 00 1D 0E 1B 06
+ 05 00 00 00 1D 06 14 DE 64 2D 03 03 55 19 03)
+ ((|COMMON-LISP|::|UNSIGNED-BYTE| 8.) #.#'|COMMON-LISP|::|VALUES|
+ |MD5|::|MD5SUM-STREAM| |COMMON-LISP|::|CLOSE| :|ABORT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|PATHNAME|)
+ "Calculate the MD5 message-digest of the file specified by pathname." 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|576 578 (DEFUN MD5-STRING (MD5-DIGEST) ...)-44|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|MD5|::|MD5-STRING| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|MD5-STRING|
+ #69Y(00 00 00 00 01 00 00 00 26 02 38 02 72 8F DA DB B0 73 00 27 38 01
+ AE 71 9D 72 8F AD 1B 0E AD 01 02 DC DD 01 02 94 07 83 08 2D 08 04
+ AC 8D 9F 6E 16 01 AC 72 90 38 02 71 4D AF 38 02 31 95 16 02 AC 32
+ 90 19 03)
+ (|COMMON-LISP|::|LIST| #.#'|COMMON-LISP|::|IDENTITY| 2. #\0
+ |SYSTEM|::|DO-FORMAT-HEXADECIMAL|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|MD5|::|MD5-DIGEST|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|581 582 (DEFUN MD5 (SEQUENCE) ...)-45|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|MD5|::|MD5| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|MD5|::|MD5| #17Y(00 00 00 00 01 00 00 00 26 02 AD 6F 00 2F 01 19 02)
+ (|MD5|::|MD5SUM-SEQUENCE| |MD5|::|MD5-STRING|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|SEQUENCE|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
Added: clfswm/contrib/server/md5.lib
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/md5.lib Thu Aug 12 17:30:52 2010
@@ -0,0 +1,946 @@
+#0Y_ #0Y |CHARSET|::|UTF-8|
+(|SYSTEM|::|%IN-PACKAGE| "MD5" :|NICKNAMES| '|COMMON-LISP|::|NIL| :|USE|
+ '|COMMON-LISP|::|NIL| :|CASE-SENSITIVE| |COMMON-LISP|::|NIL| :|CASE-INVERTED|
+ |COMMON-LISP|::|NIL|)
+(|COMMON-LISP|::|USE-PACKAGE| '("COMMON-LISP") "MD5")
+(|SYSTEM|::|INTERN-EXPORT|
+ '("MD5-REGS" "INITIAL-MD5-REGS" "MD5REGS-DIGEST" "UPDATE-MD5-BLOCK"
+ "FILL-BLOCK" "FILL-BLOCK-UB8" "FILL-BLOCK-CHAR" "MD5-STATE" "MD5-STATE-P"
+ "MAKE-MD5-STATE" "UPDATE-MD5-STATE" "FINALIZE-MD5-STATE" "MD5SUM-SEQUENCE"
+ "MD5SUM-STREAM" "MD5SUM-FILE" "MD5")
+ "MD5" |COMMON-LISP|::|NIL|)
+(|COMMON-LISP|::|FIND-PACKAGE| "MD5")
+(|COMMON-LISP|::|SETQ| |COMMON-LISP|::|*PACKAGE*|
+ (|SYSTEM|::|%FIND-PACKAGE| "MD5"))
+(|COMMON-LISP|::|DEFTYPE| |MD5|::|UB32| |COMMON-LISP|::|NIL|
+ "Corresponds to the 32bit quantity word of the MD5 Spec"
+ `(|COMMON-LISP|::|UNSIGNED-BYTE| 32.))
+(|COMMON-LISP|::|LET| |COMMON-LISP|::|NIL|
+ (|SYSTEM|::|%PUT| '|MD5|::|UB32| '|SYSTEM|::|DEFTYPE-EXPANDER|
+ (|COMMON-LISP|::|FUNCTION| #:|DEFTYPE-UB32|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<DEFTYPE-FORM>|)
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|PROPER-LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<DEFTYPE-FORM>| 1.
+ 1.))
+ (|SYSTEM|::|TYPE-CALL-ERROR| |SYSTEM|::|<DEFTYPE-FORM>|)
+ (|COMMON-LISP|::|LET*| |COMMON-LISP|::|NIL|
+ (|COMMON-LISP|::|BLOCK| |MD5|::|UB32|
+ `(|COMMON-LISP|::|UNSIGNED-BYTE| 32.)))))))
+ (|SYSTEM|::|%SET-DOCUMENTATION| '|MD5|::|UB32| '|COMMON-LISP|::|TYPE|
+ '"Corresponds to the 32bit quantity word of the MD5 Spec")
+ '|MD5|::|UB32|)
+(|COMMON-LISP|::|DEFMACRO| |MD5|::|ASSEMBLE-UB32|
+ (|MD5|::|A| |MD5|::|B| |MD5|::|C| |MD5|::|D|)
+ "Assemble an ub32 value from the given (unsigned-byte 8) values,\n
+where a is the intended low-order byte and d the high-order byte."
+ `(|COMMON-LISP|::|THE| |MD5|::|UB32|
+ (|COMMON-LISP|::|LOGIOR| (|COMMON-LISP|::|ASH| ,|MD5|::|D| 24.)
+ (|COMMON-LISP|::|ASH| ,|MD5|::|C| 16.)
+ (|COMMON-LISP|::|ASH| ,|MD5|::|B| 8.) ,|MD5|::|A|)))
+(|SYSTEM|::|REMOVE-OLD-DEFINITIONS| '|MD5|::|ASSEMBLE-UB32|)
+(|SYSTEM|::|%PUTD| '|MD5|::|ASSEMBLE-UB32|
+ (|SYSTEM|::|MAKE-MACRO|
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|ASSEMBLE-UB32|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|CONS| |SYSTEM|::|<MACRO-FORM>|))
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|IGNORE| |SYSTEM|::|<ENV-ARG>|))
+ "Assemble an ub32 value from the given (unsigned-byte 8) values,\n
+where a is the intended low-order byte and d the high-order byte."
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<MACRO-FORM>| 5. 5.
+ |COMMON-LISP|::|NIL|))
+ (|SYSTEM|::|MACRO-CALL-ERROR| |SYSTEM|::|<MACRO-FORM>|)
+ (|COMMON-LISP|::|LET*|
+ ((|MD5|::|A| (|COMMON-LISP|::|CADR| . #1=(|SYSTEM|::|<MACRO-FORM>|)))
+ (|MD5|::|B| (|COMMON-LISP|::|CADDR| . #1#))
+ (|MD5|::|C| (|COMMON-LISP|::|CADDDR| . #1#))
+ (|MD5|::|D| (|COMMON-LISP|::|FIFTH| . #1#)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|ASSEMBLE-UB32|
+ `(|COMMON-LISP|::|THE| |MD5|::|UB32|
+ (|COMMON-LISP|::|LOGIOR| (|COMMON-LISP|::|ASH| ,|MD5|::|D| 24.)
+ (|COMMON-LISP|::|ASH| ,|MD5|::|C| 16.)
+ (|COMMON-LISP|::|ASH| ,|MD5|::|B| 8.) ,|MD5|::|A|)))))))
+ '(|MD5|::|A| |MD5|::|B| |MD5|::|C| |MD5|::|D|)))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |MD5|::|F| |MD5|::|G| |MD5|::|H| |MD5|::|I|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FTYPE|
+ (|COMMON-LISP|::|FUNCTION| (|MD5|::|UB32| |MD5|::|UB32| |MD5|::|UB32|)
+ |MD5|::|UB32|)
+ |MD5|::|F| |MD5|::|G| |MD5|::|H| |MD5|::|I|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|F|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|MD5|::|X| |MD5|::|Y| |MD5|::|Z|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|F|)
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| |MD5|::|X| |MD5|::|Y| |MD5|::|Z|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|F|
+ (|COMMON-LISP|::|LOGIOR| (|COMMON-LISP|::|LOGAND| |MD5|::|X| |MD5|::|Y|)
+ (|COMMON-LISP|::|LOGANDC1| |MD5|::|X| |MD5|::|Z|)))))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|G|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|MD5|::|X| |MD5|::|Y| |MD5|::|Z|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|G|)
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| |MD5|::|X| |MD5|::|Y| |MD5|::|Z|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|G|
+ (|COMMON-LISP|::|LOGIOR| (|COMMON-LISP|::|LOGAND| |MD5|::|X| |MD5|::|Z|)
+ (|COMMON-LISP|::|LOGANDC2| |MD5|::|Y| |MD5|::|Z|)))))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|H|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|MD5|::|X| |MD5|::|Y| |MD5|::|Z|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|H|)
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| |MD5|::|X| |MD5|::|Y| |MD5|::|Z|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|H|
+ (|COMMON-LISP|::|LOGXOR| |MD5|::|X| |MD5|::|Y| |MD5|::|Z|))))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|I|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|MD5|::|X| |MD5|::|Y| |MD5|::|Z|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|I|)
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| |MD5|::|X| |MD5|::|Y| |MD5|::|Z|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|I|
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 32. 0.)
+ (|COMMON-LISP|::|LOGXOR| |MD5|::|Y|
+ (|COMMON-LISP|::|LOGORC2| |MD5|::|X| |MD5|::|Z|))))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|MOD32+|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FTYPE|
+ (|COMMON-LISP|::|FUNCTION| (|MD5|::|UB32| |MD5|::|UB32|) |MD5|::|UB32|)
+ |MD5|::|MOD32+|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MOD32+|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|MD5|::|A| |MD5|::|B|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|MOD32+|)
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| |MD5|::|A| |MD5|::|B|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MOD32+|
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 32. 0.)
+ (|COMMON-LISP|::|+| |MD5|::|A| |MD5|::|B|)))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|ROL32|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FTYPE|
+ (|COMMON-LISP|::|FUNCTION|
+ (|MD5|::|UB32| (|COMMON-LISP|::|UNSIGNED-BYTE| 5.)) |MD5|::|UB32|)
+ |MD5|::|ROL32|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|ROL32|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|MD5|::|A| |MD5|::|S|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|ROL32|)
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| |MD5|::|A|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|UNSIGNED-BYTE| 5.) |MD5|::|S|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|ROL32|
+ (|COMMON-LISP|::|LOGIOR|
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 32. 0.)
+ (|COMMON-LISP|::|ASH| |MD5|::|A| |MD5|::|S|))
+ (|COMMON-LISP|::|ASH| |MD5|::|A| (|COMMON-LISP|::|-| |MD5|::|S| 32.))))))
+(|COMMON-LISP|::|DEFPARAMETER| |MD5|::|*T*|
+ (|COMMON-LISP|::|MAKE-ARRAY| 64. :|ELEMENT-TYPE| '|MD5|::|UB32|
+ :|INITIAL-CONTENTS|
+ (|COMMON-LISP|::|LOOP| |MD5|::|FOR| |MD5|::|I| |MD5|::|FROM| 1. |MD5|::|TO|
+ 64. |MD5|::|COLLECT|
+ (|COMMON-LISP|::|TRUNCATE|
+ (|COMMON-LISP|::|*| 4294967296.
+ (|COMMON-LISP|::|ABS|
+ (|COMMON-LISP|::|SIN| (|COMMON-LISP|::|FLOAT| |MD5|::|I| 0.0d0))))))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|SPECIAL| |MD5|::|*T*|))
+(|SYSTEM|::|REMOVE-OLD-DEFINITIONS| '|MD5|::|WITH-MD5-ROUND|)
+(|SYSTEM|::|%PUTD| '|MD5|::|WITH-MD5-ROUND|
+ (|SYSTEM|::|MAKE-MACRO|
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|WITH-MD5-ROUND|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|CONS| |SYSTEM|::|<MACRO-FORM>|))
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|IGNORE| |SYSTEM|::|<ENV-ARG>|))
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<MACRO-FORM>| 2. 2.
+ |COMMON-LISP|::|T|))
+ (|SYSTEM|::|MACRO-CALL-ERROR| |SYSTEM|::|<MACRO-FORM>|)
+ (|COMMON-LISP|::|LET*|
+ ((#1=#:|G46376| (|COMMON-LISP|::|CADR| . #2=(|SYSTEM|::|<MACRO-FORM>|)))
+ (#3=#:|G46377|
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| #1# 2. 2. |COMMON-LISP|::|NIL|))
+ (|SYSTEM|::|ERROR-OF-TYPE| '|EXT|::|SOURCE-PROGRAM-ERROR| :|FORM|
+ |SYSTEM|::|<MACRO-FORM>| :|DETAIL| #1#
+ (|SYSTEM|::|TEXT| "~S: ~S does not match lambda list element ~:S")
+ '|MD5|::|WITH-MD5-ROUND| #1#
+ '#4=(|MD5|::|OP| |COMMON-LISP|::|BLOCK|))
+ #1#))
+ (|MD5|::|OP| (|COMMON-LISP|::|CAR| #3#))
+ (|COMMON-LISP|::|BLOCK| (|COMMON-LISP|::|CADR| #3#))
+ (|MD5|::|CLAUSES| (|COMMON-LISP|::|CDDR| . #2#)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|WITH-MD5-ROUND|
+ (|COMMON-LISP|::|LOOP| |MD5|::|FOR|
+ (|MD5|::|A| |MD5|::|B| |MD5|::|C| |MD5|::|D| |MD5|::|K| |MD5|::|S|
+ |MD5|::|I|)
+ |MD5|::|IN| |MD5|::|CLAUSES| |MD5|::|COLLECT|
+ `(|COMMON-LISP|::|SETQ| ,|MD5|::|A|
+ (|MD5|::|MOD32+| ,|MD5|::|B|
+ (|MD5|::|ROL32|
+ (|MD5|::|MOD32+|
+ (|MD5|::|MOD32+| ,|MD5|::|A|
+ (,|MD5|::|OP| ,|MD5|::|B| ,|MD5|::|C| ,|MD5|::|D|))
+ (|MD5|::|MOD32+|
+ (|COMMON-LISP|::|AREF| ,|COMMON-LISP|::|BLOCK| ,|MD5|::|K|)
+ ,(|COMMON-LISP|::|AREF| |MD5|::|*T*|
+ (|COMMON-LISP|::|1-| |MD5|::|I|))))
+ ,|MD5|::|S|)))
+ |MD5|::|INTO| |MD5|::|RESULT| |MD5|::|FINALLY|
+ (|COMMON-LISP|::|RETURN|
+ `(|COMMON-LISP|::|PROGN| ,@|MD5|::|RESULT|))))))))
+ '(#4# |COMMON-LISP|::|&REST| |MD5|::|CLAUSES|)))
+(|COMMON-LISP|::|LET| |COMMON-LISP|::|NIL|
+ (|SYSTEM|::|%PUT| '|MD5|::|MD5-REGS| '|SYSTEM|::|DEFTYPE-EXPANDER|
+ (|COMMON-LISP|::|FUNCTION| #:|DEFTYPE-MD5-REGS|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<DEFTYPE-FORM>|)
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|PROPER-LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<DEFTYPE-FORM>| 1.
+ 1.))
+ (|SYSTEM|::|TYPE-CALL-ERROR| |SYSTEM|::|<DEFTYPE-FORM>|)
+ (|COMMON-LISP|::|LET*| |COMMON-LISP|::|NIL|
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-REGS|
+ `(|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 32.)
+ (4.))))))))
+ (|SYSTEM|::|%SET-DOCUMENTATION| '|MD5|::|MD5-REGS| '|COMMON-LISP|::|TYPE|
+ '"The working state of the MD5 algorithm, which contains the 4 32-bit\n
+registers A, B, C and D.")
+ '|MD5|::|MD5-REGS|)
+(|SYSTEM|::|REMOVE-OLD-DEFINITIONS| '|MD5|::|MD5-REGS-A|)
+(|SYSTEM|::|%PUTD| '|MD5|::|MD5-REGS-A|
+ (|SYSTEM|::|MAKE-MACRO|
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-REGS-A|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|CONS| |SYSTEM|::|<MACRO-FORM>|))
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|IGNORE| |SYSTEM|::|<ENV-ARG>|))
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<MACRO-FORM>| 2. 2.
+ |COMMON-LISP|::|NIL|))
+ (|SYSTEM|::|MACRO-CALL-ERROR| |SYSTEM|::|<MACRO-FORM>|)
+ (|COMMON-LISP|::|LET*|
+ ((|MD5|::|REGS| (|COMMON-LISP|::|CADR| |SYSTEM|::|<MACRO-FORM>|)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-REGS-A|
+ `(|COMMON-LISP|::|AREF| ,|MD5|::|REGS| 0.))))))
+ '(|MD5|::|REGS|)))
+(|SYSTEM|::|REMOVE-OLD-DEFINITIONS| '|MD5|::|MD5-REGS-B|)
+(|SYSTEM|::|%PUTD| '|MD5|::|MD5-REGS-B|
+ (|SYSTEM|::|MAKE-MACRO|
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-REGS-B|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|CONS| |SYSTEM|::|<MACRO-FORM>|))
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|IGNORE| |SYSTEM|::|<ENV-ARG>|))
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<MACRO-FORM>| 2. 2.
+ |COMMON-LISP|::|NIL|))
+ (|SYSTEM|::|MACRO-CALL-ERROR| |SYSTEM|::|<MACRO-FORM>|)
+ (|COMMON-LISP|::|LET*|
+ ((|MD5|::|REGS| (|COMMON-LISP|::|CADR| |SYSTEM|::|<MACRO-FORM>|)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-REGS-B|
+ `(|COMMON-LISP|::|AREF| ,|MD5|::|REGS| 1.))))))
+ '(|MD5|::|REGS|)))
+(|SYSTEM|::|REMOVE-OLD-DEFINITIONS| '|MD5|::|MD5-REGS-C|)
+(|SYSTEM|::|%PUTD| '|MD5|::|MD5-REGS-C|
+ (|SYSTEM|::|MAKE-MACRO|
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-REGS-C|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|CONS| |SYSTEM|::|<MACRO-FORM>|))
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|IGNORE| |SYSTEM|::|<ENV-ARG>|))
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<MACRO-FORM>| 2. 2.
+ |COMMON-LISP|::|NIL|))
+ (|SYSTEM|::|MACRO-CALL-ERROR| |SYSTEM|::|<MACRO-FORM>|)
+ (|COMMON-LISP|::|LET*|
+ ((|MD5|::|REGS| (|COMMON-LISP|::|CADR| |SYSTEM|::|<MACRO-FORM>|)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-REGS-C|
+ `(|COMMON-LISP|::|AREF| ,|MD5|::|REGS| 2.))))))
+ '(|MD5|::|REGS|)))
+(|SYSTEM|::|REMOVE-OLD-DEFINITIONS| '|MD5|::|MD5-REGS-D|)
+(|SYSTEM|::|%PUTD| '|MD5|::|MD5-REGS-D|
+ (|SYSTEM|::|MAKE-MACRO|
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-REGS-D|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|CONS| |SYSTEM|::|<MACRO-FORM>|))
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|IGNORE| |SYSTEM|::|<ENV-ARG>|))
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<MACRO-FORM>| 2. 2.
+ |COMMON-LISP|::|NIL|))
+ (|SYSTEM|::|MACRO-CALL-ERROR| |SYSTEM|::|<MACRO-FORM>|)
+ (|COMMON-LISP|::|LET*|
+ ((|MD5|::|REGS| (|COMMON-LISP|::|CADR| |SYSTEM|::|<MACRO-FORM>|)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-REGS-D|
+ `(|COMMON-LISP|::|AREF| ,|MD5|::|REGS| 3.))))))
+ '(|MD5|::|REGS|)))
+(|SYSTEM|::|C-PROCLAIM-CONSTANT| '|MD5|::|+MD5-MAGIC-A+|
+ '(|MD5|::|ASSEMBLE-UB32| 1. 35. 69. 103.))
+(|SYSTEM|::|C-PROCLAIM-CONSTANT| '|MD5|::|+MD5-MAGIC-B+|
+ '(|MD5|::|ASSEMBLE-UB32| 137. 171. 205. 239.))
+(|SYSTEM|::|C-PROCLAIM-CONSTANT| '|MD5|::|+MD5-MAGIC-C+|
+ '(|MD5|::|ASSEMBLE-UB32| 254. 220. 186. 152.))
+(|SYSTEM|::|C-PROCLAIM-CONSTANT| '|MD5|::|+MD5-MAGIC-D+|
+ '(|MD5|::|ASSEMBLE-UB32| 118. 84. 50. 16.))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|INITIAL-MD5-REGS|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|INITIAL-MD5-REGS|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '|COMMON-LISP|::|NIL|)
+ '(|COMMON-LISP|::|NIL| "Create the initial working state of an MD5 run."
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|INITIAL-MD5-REGS|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|INITIAL-MD5-REGS|
+ (|COMMON-LISP|::|LET|
+ ((|MD5|::|REGS|
+ (|COMMON-LISP|::|MAKE-ARRAY| 4. :|ELEMENT-TYPE|
+ '(|COMMON-LISP|::|UNSIGNED-BYTE| 32.))))
+ (|COMMON-LISP|::|DECLARE|
+ (|COMMON-LISP|::|TYPE| |MD5|::|MD5-REGS| |MD5|::|REGS|))
+ (|COMMON-LISP|::|SETF| (|MD5|::|MD5-REGS-A| |MD5|::|REGS|)
+ |MD5|::|+MD5-MAGIC-A+| (|MD5|::|MD5-REGS-B| |MD5|::|REGS|)
+ |MD5|::|+MD5-MAGIC-B+| (|MD5|::|MD5-REGS-C| |MD5|::|REGS|)
+ |MD5|::|+MD5-MAGIC-C+| (|MD5|::|MD5-REGS-D| |MD5|::|REGS|)
+ |MD5|::|+MD5-MAGIC-D+|)
+ |MD5|::|REGS|))))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|UPDATE-MD5-BLOCK|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|MD5|::|REGS| |COMMON-LISP|::|BLOCK|)))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |MD5|::|FILL-BLOCK| |MD5|::|FILL-BLOCK-UB8|
+ |MD5|::|FILL-BLOCK-CHAR|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|FILL-BLOCK-UB8|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#1=(|COMMON-LISP|::|BLOCK| |MD5|::|BUFFER| |MD5|::|OFFSET|))
+ '(#1#
+ "Convert a complete 64 (unsigned-byte 8) input vector segment\n
+starting from offset into the given 16 word MD5 block."
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|FILL-BLOCK-UB8|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|INTEGER| 0. 16777151.)
+ |MD5|::|OFFSET|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|SIMPLE-ARRAY| |MD5|::|UB32| (16.))
+ |COMMON-LISP|::|BLOCK|)
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (|COMMON-LISP|::|*|))
+ |MD5|::|BUFFER|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|FILL-BLOCK-UB8|
+ (|COMMON-LISP|::|LOOP| |MD5|::|FOR| |MD5|::|I| |MD5|::|OF-TYPE|
+ (|COMMON-LISP|::|INTEGER| 0. 16.) |MD5|::|FROM| 0. |MD5|::|FOR| |MD5|::|J|
+ |MD5|::|OF-TYPE| (|COMMON-LISP|::|INTEGER| 0. 16777215.) |MD5|::|FROM|
+ |MD5|::|OFFSET| |MD5|::|TO| (|COMMON-LISP|::|+| |MD5|::|OFFSET| 63.)
+ |MD5|::|BY| 4. |COMMON-LISP|::|DO|
+ (|COMMON-LISP|::|SETF|
+ (|COMMON-LISP|::|AREF| |COMMON-LISP|::|BLOCK| |MD5|::|I|)
+ (|MD5|::|ASSEMBLE-UB32|
+ (|COMMON-LISP|::|AREF| |MD5|::|BUFFER| |MD5|::|J|)
+ (|COMMON-LISP|::|AREF| |MD5|::|BUFFER|
+ (|COMMON-LISP|::|+| |MD5|::|J| 1.))
+ (|COMMON-LISP|::|AREF| |MD5|::|BUFFER|
+ (|COMMON-LISP|::|+| |MD5|::|J| 2.))
+ (|COMMON-LISP|::|AREF| |MD5|::|BUFFER|
+ (|COMMON-LISP|::|+| |MD5|::|J| 3.))))))))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|FILL-BLOCK-CHAR|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#1=(|COMMON-LISP|::|BLOCK| |MD5|::|BUFFER| |MD5|::|OFFSET|))
+ '(#1#
+ "Convert a complete 64 character input string segment starting from\n
+offset into the given 16 word MD5 block."
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|FILL-BLOCK-CHAR|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|INTEGER| 0. 16777151.)
+ |MD5|::|OFFSET|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|SIMPLE-ARRAY| |MD5|::|UB32| (16.))
+ |COMMON-LISP|::|BLOCK|)
+ (|COMMON-LISP|::|TYPE| |COMMON-LISP|::|SIMPLE-STRING| |MD5|::|BUFFER|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|FILL-BLOCK-CHAR|
+ (|COMMON-LISP|::|LOOP| |MD5|::|FOR| |MD5|::|I| |MD5|::|OF-TYPE|
+ (|COMMON-LISP|::|INTEGER| 0. 16.) |MD5|::|FROM| 0. |MD5|::|FOR| |MD5|::|J|
+ |MD5|::|OF-TYPE| (|COMMON-LISP|::|INTEGER| 0. 16777215.) |MD5|::|FROM|
+ |MD5|::|OFFSET| |MD5|::|TO| (|COMMON-LISP|::|+| |MD5|::|OFFSET| 63.)
+ |MD5|::|BY| 4. |COMMON-LISP|::|DO|
+ (|COMMON-LISP|::|SETF|
+ (|COMMON-LISP|::|AREF| |COMMON-LISP|::|BLOCK| |MD5|::|I|)
+ (|MD5|::|ASSEMBLE-UB32|
+ (|COMMON-LISP|::|CHAR-CODE|
+ (|COMMON-LISP|::|SCHAR| |MD5|::|BUFFER| |MD5|::|J|))
+ (|COMMON-LISP|::|CHAR-CODE|
+ (|COMMON-LISP|::|SCHAR| |MD5|::|BUFFER|
+ (|COMMON-LISP|::|+| |MD5|::|J| 1.)))
+ (|COMMON-LISP|::|CHAR-CODE|
+ (|COMMON-LISP|::|SCHAR| |MD5|::|BUFFER|
+ (|COMMON-LISP|::|+| |MD5|::|J| 2.)))
+ (|COMMON-LISP|::|CHAR-CODE|
+ (|COMMON-LISP|::|SCHAR| |MD5|::|BUFFER|
+ (|COMMON-LISP|::|+| |MD5|::|J| 3.)))))))))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|FILL-BLOCK|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#1=(|COMMON-LISP|::|BLOCK| |MD5|::|BUFFER| |MD5|::|OFFSET|))
+ '(#1#
+ "Convert a complete 64 byte input vector segment into the given 16\n
+word MD5 block. This currently works on (unsigned-byte 8) and\n
+character simple-arrays, via the functions `fill-block-ub8' and\n
+`fill-block-char' respectively."
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|FILL-BLOCK|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|INTEGER| 0. 16777151.)
+ |MD5|::|OFFSET|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|SIMPLE-ARRAY| |MD5|::|UB32| (16.))
+ |COMMON-LISP|::|BLOCK|)
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| |COMMON-LISP|::|*| (|COMMON-LISP|::|*|))
+ |MD5|::|BUFFER|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.)))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|FILL-BLOCK|
+ (|COMMON-LISP|::|ETYPECASE| |MD5|::|BUFFER|
+ ((|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (|COMMON-LISP|::|*|))
+ (|MD5|::|FILL-BLOCK-UB8| |COMMON-LISP|::|BLOCK| |MD5|::|BUFFER|
+ |MD5|::|OFFSET|))
+ (|COMMON-LISP|::|SIMPLE-STRING|
+ (|MD5|::|FILL-BLOCK-CHAR| |COMMON-LISP|::|BLOCK| |MD5|::|BUFFER|
+ |MD5|::|OFFSET|))))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|MD5REGS-DIGEST|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5REGS-DIGEST|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|MD5|::|REGS|))
+ '(#1#
+ "Create the final 16 byte message-digest from the MD5 working state\n
+in regs. Returns a (simple-array (unsigned-byte 8) (16))."
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5REGS-DIGEST|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.))
+ (|COMMON-LISP|::|TYPE| |MD5|::|MD5-REGS| |MD5|::|REGS|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5REGS-DIGEST|
+ (|COMMON-LISP|::|LET|
+ ((|MD5|::|RESULT|
+ (|COMMON-LISP|::|MAKE-ARRAY| 16. :|ELEMENT-TYPE|
+ '(|COMMON-LISP|::|UNSIGNED-BYTE| 8.))))
+ (|COMMON-LISP|::|DECLARE|
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (16.))
+ |MD5|::|RESULT|))
+ (|COMMON-LISP|::|MACROLET|
+ ((|MD5|::|FROB| (|MD5|::|REG| |MD5|::|OFFSET|)
+ (|COMMON-LISP|::|LET| ((|MD5|::|VAR| (|COMMON-LISP|::|GENSYM|)))
+ `(|COMMON-LISP|::|LET| ((,|MD5|::|VAR| ,|MD5|::|REG|))
+ (|COMMON-LISP|::|DECLARE|
+ (|COMMON-LISP|::|TYPE| |MD5|::|UB32| ,|MD5|::|VAR|))
+ (|COMMON-LISP|::|SETF|
+ (|COMMON-LISP|::|AREF| |MD5|::|RESULT| ,|MD5|::|OFFSET|)
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 8. 0.) ,|MD5|::|VAR|)
+ (|COMMON-LISP|::|AREF| |MD5|::|RESULT|
+ ,(|COMMON-LISP|::|+| |MD5|::|OFFSET| 1.))
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 8. 8.) ,|MD5|::|VAR|)
+ (|COMMON-LISP|::|AREF| |MD5|::|RESULT|
+ ,(|COMMON-LISP|::|+| |MD5|::|OFFSET| 2.))
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 8. 16.) ,|MD5|::|VAR|)
+ (|COMMON-LISP|::|AREF| |MD5|::|RESULT|
+ ,(|COMMON-LISP|::|+| |MD5|::|OFFSET| 3.))
+ (|COMMON-LISP|::|LDB| (|COMMON-LISP|::|BYTE| 8. 24.)
+ ,|MD5|::|VAR|))))))
+ (|MD5|::|FROB| (|MD5|::|MD5-REGS-A| |MD5|::|REGS|) 0.)
+ (|MD5|::|FROB| (|MD5|::|MD5-REGS-B| |MD5|::|REGS|) 4.)
+ (|MD5|::|FROB| (|MD5|::|MD5-REGS-C| |MD5|::|REGS|) 8.)
+ (|MD5|::|FROB| (|MD5|::|MD5-REGS-D| |MD5|::|REGS|) 12.))
+ |MD5|::|RESULT|))))
+(|COMMON-LISP|::|LET| |COMMON-LISP|::|NIL|
+ (|COMMON-LISP|::|LET|
+ ((#1=#:|G46629|
+ (|COMMON-LISP|::|CONS| '|MD5|::|MD5-STATE|
+ (|CLOS|::|CLASS-NAMES|
+ (|COMMON-LISP|::|GET| '|COMMON-LISP|::|STRUCTURE-OBJECT|
+ '|CLOS|::|CLOSCLASS|))))
+ (#2=#:|G46630|
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|DEFAULT-REGS|
+ (|COMMON-LISP|::|LAMBDA| |COMMON-LISP|::|NIL|
+ #3=(|MD5|::|INITIAL-MD5-REGS|))))
+ (#4=#:|G46631|
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|DEFAULT-BLOCK|
+ (|COMMON-LISP|::|LAMBDA| |COMMON-LISP|::|NIL|
+ #5=(|COMMON-LISP|::|MAKE-ARRAY| 16. :|ELEMENT-TYPE|
+ '(|COMMON-LISP|::|UNSIGNED-BYTE| 32.)))))
+ (#6=#:|G46632|
+ (|COMMON-LISP|::|FUNCTION| |MD5|::|DEFAULT-BUFFER|
+ (|COMMON-LISP|::|LAMBDA| |COMMON-LISP|::|NIL|
+ #7=(|COMMON-LISP|::|MAKE-ARRAY| 64. :|ELEMENT-TYPE|
+ '(|COMMON-LISP|::|UNSIGNED-BYTE| 8.))))))
+ (|SYSTEM|::|STRUCTURE-UNDEFINE-ACCESSORIES| '|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|REMPROP| '|MD5|::|MD5-STATE|
+ '|SYSTEM|::|DEFSTRUCT-DESCRIPTION|)
+ (|CLOS|::|DEFINE-STRUCTURE-CLASS| '|MD5|::|MD5-STATE| #1#
+ '|COMMON-LISP|::|NIL| '(|MD5|::|MAKE-MD5-STATE|) '|MD5|::|COPY-MD5-STATE|
+ '|MD5|::|MD5-STATE-P|
+ (|COMMON-LISP|::|LIST|
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME| '|MD5|::|REGS|
+ :|INITARGS| '#8=(:|REGS|) :|TYPE| '|MD5|::|MD5-REGS| :|ALLOCATION|
+ ':|INSTANCE| #9='|CLOS|::|INHERITABLE-INITER|
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '#3# #2#)
+ #10='|CLOS|::|INHERITABLE-DOC| '(|COMMON-LISP|::|NIL|)
+ #11='|CLOS|::|LOCATION| '1. #12='|CLOS|::|READONLY| '|COMMON-LISP|::|T|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME| '|MD5|::|AMOUNT|
+ :|INITARGS| '#13=(:|AMOUNT|) :|TYPE|
+ '#14=(|COMMON-LISP|::|INTEGER| 0. |COMMON-LISP|::|*|) :|ALLOCATION|
+ ':|INSTANCE| #9#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '0.
+ #15=(|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| 0.))
+ #10# '(|COMMON-LISP|::|NIL|) #11# '2. #12# '|COMMON-LISP|::|NIL|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME|
+ '|COMMON-LISP|::|BLOCK| :|INITARGS| '#16=(:|BLOCK|) :|TYPE|
+ '#17=(|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 32.)
+ (16.))
+ :|ALLOCATION| ':|INSTANCE| #9#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '#5# #4#) #10#
+ '(|COMMON-LISP|::|NIL|) #11# '3. #12# '|COMMON-LISP|::|T|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME| '|MD5|::|BUFFER|
+ :|INITARGS| '#18=(:|BUFFER|) :|TYPE|
+ '#19=(|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (64.))
+ :|ALLOCATION| ':|INSTANCE| #9#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '#7# #6#) #10#
+ '(|COMMON-LISP|::|NIL|) #11# '4. #12# '|COMMON-LISP|::|T|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME|
+ '|MD5|::|BUFFER-INDEX| :|INITARGS| '#20=(:|BUFFER-INDEX|) :|TYPE|
+ '#21=(|COMMON-LISP|::|INTEGER| 0. 63.) :|ALLOCATION| ':|INSTANCE| #9#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '0.
+ #22=(|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| 0.))
+ #10# '(|COMMON-LISP|::|NIL|) #11# '5. #12# '|COMMON-LISP|::|NIL|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME|
+ '|MD5|::|FINALIZED-P| :|INITARGS| '#23=(:|FINALIZED-P|) :|TYPE|
+ '|COMMON-LISP|::|T| :|ALLOCATION| ':|INSTANCE| #9#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '|COMMON-LISP|::|NIL|
+ #24=(|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| |COMMON-LISP|::|NIL|))
+ #10# '(|COMMON-LISP|::|NIL|) #11# '6. #12# '|COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|LIST|
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME| '|MD5|::|REGS|
+ :|INITARGS| '#8# :|TYPE| '|MD5|::|MD5-REGS| :|ALLOCATION| ':|INSTANCE|
+ #25='|CLOS|::|INHERITABLE-INITER|
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '#3# #2#)
+ #26='|CLOS|::|INHERITABLE-DOC| '(|COMMON-LISP|::|NIL|) :|READERS|
+ '(|MD5|::|MD5-STATE-REGS|) :|WRITERS| '|COMMON-LISP|::|NIL|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME| '|MD5|::|AMOUNT|
+ :|INITARGS| '#13# :|TYPE| '#14# :|ALLOCATION| ':|INSTANCE| #25#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '0. #15#) #26#
+ '(|COMMON-LISP|::|NIL|) :|READERS| '(|MD5|::|MD5-STATE-AMOUNT|) :|WRITERS|
+ '((|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-AMOUNT|)))
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME|
+ '|COMMON-LISP|::|BLOCK| :|INITARGS| '#16# :|TYPE| '#17# :|ALLOCATION|
+ ':|INSTANCE| #25#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '#5# #4#) #26#
+ '(|COMMON-LISP|::|NIL|) :|READERS| '(|MD5|::|MD5-STATE-BLOCK|) :|WRITERS|
+ '|COMMON-LISP|::|NIL|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME| '|MD5|::|BUFFER|
+ :|INITARGS| '#18# :|TYPE| '#19# :|ALLOCATION| ':|INSTANCE| #25#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '#7# #6#) #26#
+ '(|COMMON-LISP|::|NIL|) :|READERS| '(|MD5|::|MD5-STATE-BUFFER|) :|WRITERS|
+ '|COMMON-LISP|::|NIL|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME|
+ '|MD5|::|BUFFER-INDEX| :|INITARGS| '#20# :|TYPE| '#21# :|ALLOCATION|
+ ':|INSTANCE| #25#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '0. #22#) #26#
+ '(|COMMON-LISP|::|NIL|) :|READERS| '(|MD5|::|MD5-STATE-BUFFER-INDEX|)
+ :|WRITERS| '((|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-BUFFER-INDEX|)))
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME| '|MD5|::|FINALIZED-P|
+ :|INITARGS| '#23# :|TYPE| '|COMMON-LISP|::|T| :|ALLOCATION| ':|INSTANCE|
+ #25#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '|COMMON-LISP|::|NIL|
+ #24#)
+ #26# '(|COMMON-LISP|::|NIL|) :|READERS| '(|MD5|::|MD5-STATE-FINALIZED-P|)
+ :|WRITERS| '((|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-FINALIZED-P|)))))
+ (|COMMON-LISP|::|DEFUN| |MD5|::|MAKE-MD5-STATE|
+ (|COMMON-LISP|::|&AUX| (|MD5|::|REGS| #3#) (|MD5|::|AMOUNT| 0.)
+ (|COMMON-LISP|::|BLOCK| #5#) (|MD5|::|BUFFER| #7#)
+ (|MD5|::|BUFFER-INDEX| 0.) (|MD5|::|FINALIZED-P| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|LET|
+ ((|SYSTEM|::|OBJECT| (|SYSTEM|::|%MAKE-STRUCTURE| #1# 7.)))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 1.)
+ (|COMMON-LISP|::|THE| |MD5|::|MD5-REGS| |MD5|::|REGS|))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 2.)
+ (|COMMON-LISP|::|THE| #14# |MD5|::|AMOUNT|))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 3.)
+ (|COMMON-LISP|::|THE| #17# |COMMON-LISP|::|BLOCK|))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 4.)
+ (|COMMON-LISP|::|THE| #19# |MD5|::|BUFFER|))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 5.)
+ (|COMMON-LISP|::|THE| #21# |MD5|::|BUFFER-INDEX|))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 6.)
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|T| |MD5|::|FINALIZED-P|))
+ |SYSTEM|::|OBJECT|)))
+ (|COMMON-LISP|::|PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-P|))
+ (|COMMON-LISP|::|DEFUN| |MD5|::|MD5-STATE-P| (|SYSTEM|::|OBJECT|)
+ (|SYSTEM|::|%STRUCTURE-TYPE-P| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT|))
+ (|COMMON-LISP|::|PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|COPY-MD5-STATE|))
+ (|COMMON-LISP|::|DEFUN| |MD5|::|COPY-MD5-STATE| (|COMMON-LISP|::|STRUCTURE|)
+ (|COMMON-LISP|::|COPY-STRUCTURE| |COMMON-LISP|::|STRUCTURE|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-REGS| (|MD5|::|MD5-STATE|)
+ |MD5|::|MD5-REGS|))
+ (|COMMON-LISP|::|PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-REGS|))
+ (|COMMON-LISP|::|DEFUN| |MD5|::|MD5-STATE-REGS| #27=(|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|THE| |MD5|::|MD5-REGS|
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 1.)))
+ (|SYSTEM|::|%PUT| '|MD5|::|MD5-STATE-REGS| #28='|SYSTEM|::|DEFSTRUCT-READER|
+ '|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-AMOUNT| (|MD5|::|MD5-STATE|)
+ #14#))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-AMOUNT|))
+ (|COMMON-LISP|::|DEFUN| |MD5|::|MD5-STATE-AMOUNT| #27#
+ (|COMMON-LISP|::|THE| #14#
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 2.)))
+ (|SYSTEM|::|%PUT| '|MD5|::|MD5-STATE-AMOUNT| #28# '|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-BLOCK| (|MD5|::|MD5-STATE|)
+ #17#))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-BLOCK|))
+ (|COMMON-LISP|::|DEFUN| |MD5|::|MD5-STATE-BLOCK| #27#
+ (|COMMON-LISP|::|THE| #17#
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 3.)))
+ (|SYSTEM|::|%PUT| '|MD5|::|MD5-STATE-BLOCK| #28# '|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-BUFFER| (|MD5|::|MD5-STATE|)
+ #19#))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-BUFFER|))
+ (|COMMON-LISP|::|DEFUN| |MD5|::|MD5-STATE-BUFFER| #27#
+ (|COMMON-LISP|::|THE| #19#
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 4.)))
+ (|SYSTEM|::|%PUT| '|MD5|::|MD5-STATE-BUFFER| #28# '|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-BUFFER-INDEX|
+ (|MD5|::|MD5-STATE|) #21#))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-BUFFER-INDEX|))
+ (|COMMON-LISP|::|DEFUN| |MD5|::|MD5-STATE-BUFFER-INDEX| #27#
+ (|COMMON-LISP|::|THE| #21#
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 5.)))
+ (|SYSTEM|::|%PUT| '|MD5|::|MD5-STATE-BUFFER-INDEX| #28# '|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-FINALIZED-P|
+ (|MD5|::|MD5-STATE|) |COMMON-LISP|::|T|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-FINALIZED-P|))
+ (|COMMON-LISP|::|DEFUN| |MD5|::|MD5-STATE-FINALIZED-P| #27#
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|T|
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 6.)))
+ (|SYSTEM|::|%PUT| '|MD5|::|MD5-STATE-FINALIZED-P| #28# '|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-AMOUNT|)
+ (#14# |MD5|::|MD5-STATE|) #14#))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-AMOUNT|)))
+ (|COMMON-LISP|::|DEFUN| (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-AMOUNT|)
+ #29=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|SYSTEM|::|%STRUCTURE-STORE| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 2.
+ (|COMMON-LISP|::|THE| #14# . #30=(|SYSTEM|::|VALUE|))))
+ (|SYSTEM|::|%PUT| '|MD5|::|MD5-STATE-AMOUNT| #31='|SYSTEM|::|DEFSTRUCT-WRITER|
+ '|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-BUFFER-INDEX|)
+ (#21# |MD5|::|MD5-STATE|) #21#))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-BUFFER-INDEX|)))
+ (|COMMON-LISP|::|DEFUN|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-BUFFER-INDEX|) #29#
+ (|SYSTEM|::|%STRUCTURE-STORE| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 5.
+ (|COMMON-LISP|::|THE| #21# . #30#)))
+ (|SYSTEM|::|%PUT| '|MD5|::|MD5-STATE-BUFFER-INDEX| #31# '|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-FINALIZED-P|)
+ (|COMMON-LISP|::|T| |MD5|::|MD5-STATE|) |COMMON-LISP|::|T|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-FINALIZED-P|)))
+ (|COMMON-LISP|::|DEFUN| (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-FINALIZED-P|)
+ #29#
+ (|SYSTEM|::|%STRUCTURE-STORE| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 6.
+ |SYSTEM|::|VALUE|))
+ (|SYSTEM|::|%PUT| '|MD5|::|MD5-STATE-FINALIZED-P| #31# '|MD5|::|MD5-STATE|)
+ (|SYSTEM|::|%SET-DOCUMENTATION| '|MD5|::|MD5-STATE| '|COMMON-LISP|::|TYPE|
+ |COMMON-LISP|::|NIL|)
+ (|CLOS|::|DEFSTRUCT-REMOVE-PRINT-OBJECT-METHOD| '|MD5|::|MD5-STATE|)
+ '|MD5|::|MD5-STATE|)
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MAKE-MD5-STATE|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|&AUX| (|MD5|::|REGS| (|MD5|::|INITIAL-MD5-REGS|))
+ (|MD5|::|AMOUNT| 0.)
+ (|COMMON-LISP|::|BLOCK|
+ (|COMMON-LISP|::|MAKE-ARRAY| 16. :|ELEMENT-TYPE|
+ '(|COMMON-LISP|::|UNSIGNED-BYTE| 32.)))
+ (|MD5|::|BUFFER|
+ (|COMMON-LISP|::|MAKE-ARRAY| 64. :|ELEMENT-TYPE|
+ '(|COMMON-LISP|::|UNSIGNED-BYTE| 8.)))
+ (|MD5|::|BUFFER-INDEX| 0.) (|MD5|::|FINALIZED-P| |COMMON-LISP|::|NIL|))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-P|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5-STATE-P|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-P|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-P|
+ (|SYSTEM|::|%STRUCTURE-TYPE-P| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT|))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|COPY-MD5-STATE|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|COPY-MD5-STATE|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|COMMON-LISP|::|STRUCTURE|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|COPY-MD5-STATE|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|COPY-MD5-STATE|
+ (|COMMON-LISP|::|COPY-STRUCTURE| |COMMON-LISP|::|STRUCTURE|))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-REGS| (|MD5|::|MD5-STATE|)
+ |MD5|::|MD5-REGS|))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-REGS|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5-STATE-REGS|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-REGS|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-REGS|
+ (|COMMON-LISP|::|THE| |MD5|::|MD5-REGS|
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 1.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-AMOUNT| (|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|INTEGER| 0. |COMMON-LISP|::|*|)))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-AMOUNT|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5-STATE-AMOUNT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-AMOUNT|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-AMOUNT|
+ (|COMMON-LISP|::|THE| (|COMMON-LISP|::|INTEGER| 0. |COMMON-LISP|::|*|)
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 2.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-BLOCK| (|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 32.) (16.))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-BLOCK|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5-STATE-BLOCK|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-BLOCK|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-BLOCK|
+ (|COMMON-LISP|::|THE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 32.) (16.))
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 3.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-BUFFER| (|MD5|::|MD5-STATE|)
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.) (64.))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-BUFFER|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5-STATE-BUFFER|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-BUFFER|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-BUFFER|
+ (|COMMON-LISP|::|THE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.) (64.))
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 4.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-BUFFER-INDEX|
+ (|MD5|::|MD5-STATE|) (|COMMON-LISP|::|INTEGER| 0. 63.)))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-BUFFER-INDEX|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5-STATE-BUFFER-INDEX|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-BUFFER-INDEX|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-BUFFER-INDEX|
+ (|COMMON-LISP|::|THE| (|COMMON-LISP|::|INTEGER| 0. 63.)
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 5.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |MD5|::|MD5-STATE-FINALIZED-P|
+ (|MD5|::|MD5-STATE|) |COMMON-LISP|::|T|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |MD5|::|MD5-STATE-FINALIZED-P|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5-STATE-FINALIZED-P|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| |MD5|::|MD5-STATE-FINALIZED-P|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-FINALIZED-P|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|T|
+ (|SYSTEM|::|%STRUCTURE-REF| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 6.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-AMOUNT|)
+ (#1=(|COMMON-LISP|::|INTEGER| 0. |COMMON-LISP|::|*|) |MD5|::|MD5-STATE|)
+ #1#))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-AMOUNT|)))
+(|SYSTEM|::|C-DEFUN| '#1=(|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-AMOUNT|)
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#2=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|))
+ '(#2# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| #1#))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-AMOUNT|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 2.
+ (|COMMON-LISP|::|THE| (|COMMON-LISP|::|INTEGER| 0. |COMMON-LISP|::|*|)
+ |SYSTEM|::|VALUE|)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-BUFFER-INDEX|)
+ (#1=(|COMMON-LISP|::|INTEGER| 0. 63.) |MD5|::|MD5-STATE|) #1#))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-BUFFER-INDEX|)))
+(|SYSTEM|::|C-DEFUN|
+ '#1=(|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-BUFFER-INDEX|)
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#2=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|))
+ '(#2# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| #1#))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-BUFFER-INDEX|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 5.
+ (|COMMON-LISP|::|THE| (|COMMON-LISP|::|INTEGER| 0. 63.)
+ |SYSTEM|::|VALUE|)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-FINALIZED-P|)
+ (|COMMON-LISP|::|T| |MD5|::|MD5-STATE|) |COMMON-LISP|::|T|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE|
+ (|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-FINALIZED-P|)))
+(|SYSTEM|::|C-DEFUN| '#1=(|COMMON-LISP|::|SETF| |MD5|::|MD5-STATE-FINALIZED-P|)
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#2=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|))
+ '(#2# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| #1#))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|MD5-STATE-FINALIZED-P|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|MD5|::|MD5-STATE| |SYSTEM|::|OBJECT| 6.
+ |SYSTEM|::|VALUE|))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |MD5|::|COPY-TO-BUFFER|))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|COPY-TO-BUFFER|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#1=(|MD5|::|FROM| |MD5|::|FROM-OFFSET| |COMMON-LISP|::|COUNT|
+ |MD5|::|BUFFER| |MD5|::|BUFFER-OFFSET|))
+ '(#1#
+ "Copy a partial segment from input vector from starting at\n
+from-offset and copying count elements into the 64 byte buffer\n
+starting at buffer-offset."
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |MD5|::|COPY-TO-BUFFER|)
+ (|COMMON-LISP|::|OPTIMIZE| (|COMMON-LISP|::|SPEED| 3.)
+ (|COMMON-LISP|::|SAFETY| 0.) (|COMMON-LISP|::|SPACE| 0.)
+ (|COMMON-LISP|::|DEBUG| 0.))
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|UNSIGNED-BYTE| 29.)
+ |MD5|::|FROM-OFFSET|)
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|INTEGER| 0. 63.)
+ |COMMON-LISP|::|COUNT| |MD5|::|BUFFER-OFFSET|)
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| |COMMON-LISP|::|*| (|COMMON-LISP|::|*|))
+ |MD5|::|FROM|)
+ (|COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.) (64.))
+ |MD5|::|BUFFER|))
+ (|COMMON-LISP|::|BLOCK| |MD5|::|COPY-TO-BUFFER|
+ (|COMMON-LISP|::|ETYPECASE| |MD5|::|FROM|
+ (|COMMON-LISP|::|SIMPLE-STRING|
+ (|COMMON-LISP|::|LOOP| |MD5|::|FOR| |MD5|::|BUFFER-INDEX|
+ |MD5|::|OF-TYPE| (|COMMON-LISP|::|INTEGER| 0. 64.) |MD5|::|FROM|
+ |MD5|::|BUFFER-OFFSET| |MD5|::|FOR| |MD5|::|FROM-INDEX| |MD5|::|OF-TYPE|
+ |COMMON-LISP|::|FIXNUM| |MD5|::|FROM| |MD5|::|FROM-OFFSET|
+ |MD5|::|BELOW|
+ (|COMMON-LISP|::|+| |MD5|::|FROM-OFFSET| |COMMON-LISP|::|COUNT|)
+ |COMMON-LISP|::|DO|
+ (|COMMON-LISP|::|SETF|
+ (|COMMON-LISP|::|AREF| |MD5|::|BUFFER| |MD5|::|BUFFER-INDEX|)
+ (|COMMON-LISP|::|CHAR-CODE|
+ (|COMMON-LISP|::|SCHAR|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING| |MD5|::|FROM|)
+ |MD5|::|FROM-INDEX|)))))
+ ((|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (|COMMON-LISP|::|*|))
+ (|COMMON-LISP|::|LOOP| |MD5|::|FOR| |MD5|::|BUFFER-INDEX|
+ |MD5|::|OF-TYPE| (|COMMON-LISP|::|INTEGER| 0. 64.) |MD5|::|FROM|
+ |MD5|::|BUFFER-OFFSET| |MD5|::|FOR| |MD5|::|FROM-INDEX| |MD5|::|OF-TYPE|
+ |COMMON-LISP|::|FIXNUM| |MD5|::|FROM| |MD5|::|FROM-OFFSET|
+ |MD5|::|BELOW|
+ (|COMMON-LISP|::|+| |MD5|::|FROM-OFFSET| |COMMON-LISP|::|COUNT|)
+ |COMMON-LISP|::|DO|
+ (|COMMON-LISP|::|SETF|
+ (|COMMON-LISP|::|AREF| |MD5|::|BUFFER| |MD5|::|BUFFER-INDEX|)
+ (|COMMON-LISP|::|AREF|
+ (|COMMON-LISP|::|THE|
+ (|COMMON-LISP|::|SIMPLE-ARRAY| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ (|COMMON-LISP|::|*|))
+ |MD5|::|FROM|)
+ |MD5|::|FROM-INDEX|))))))))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|UPDATE-MD5-STATE|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|MD5|::|STATE| |COMMON-LISP|::|SEQUENCE| |COMMON-LISP|::|&KEY|
+ (|MD5|::|START| 0.)
+ (|MD5|::|END| (|COMMON-LISP|::|LENGTH| |COMMON-LISP|::|SEQUENCE|)))))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|FINALIZE-MD5-STATE|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|MD5|::|STATE|)))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5SUM-SEQUENCE|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|SEQUENCE| |COMMON-LISP|::|&KEY| (|MD5|::|START| 0.)
+ |MD5|::|END|)))
+(|COMMON-LISP|::|DEFCONSTANT| |MD5|::|+BUFFER-SIZE+|
+ (|COMMON-LISP|::|*| 128. 1024.)
+ "Size of internal buffer to use for md5sum-stream and md5sum-file\n
+operations. This should be a multiple of 64, the MD5 block size.")
+(|SYSTEM|::|C-PROCLAIM-CONSTANT| '|MD5|::|+BUFFER-SIZE+|
+ '(|COMMON-LISP|::|*| 128. 1024.))
+(|COMMON-LISP|::|LET| |COMMON-LISP|::|NIL|
+ (|SYSTEM|::|%PUT| '|MD5|::|BUFFER-INDEX| '|SYSTEM|::|DEFTYPE-EXPANDER|
+ (|COMMON-LISP|::|FUNCTION| #:|DEFTYPE-BUFFER-INDEX|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<DEFTYPE-FORM>|)
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|PROPER-LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<DEFTYPE-FORM>| 1.
+ 1.))
+ (|SYSTEM|::|TYPE-CALL-ERROR| |SYSTEM|::|<DEFTYPE-FORM>|)
+ (|COMMON-LISP|::|LET*| |COMMON-LISP|::|NIL|
+ (|COMMON-LISP|::|BLOCK| |MD5|::|BUFFER-INDEX|
+ `(|COMMON-LISP|::|INTEGER| 0. ,|MD5|::|+BUFFER-SIZE+|)))))))
+ (|SYSTEM|::|%SET-DOCUMENTATION| '|MD5|::|BUFFER-INDEX| '|COMMON-LISP|::|TYPE|
+ '|COMMON-LISP|::|NIL|)
+ '|MD5|::|BUFFER-INDEX|)
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5SUM-STREAM|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|COMMON-LISP|::|STREAM|)))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5SUM-FILE|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|COMMON-LISP|::|PATHNAME|)))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5-STRING|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|MD5|::|MD5-DIGEST|)))
+(|SYSTEM|::|C-DEFUN| '|MD5|::|MD5|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|COMMON-LISP|::|SEQUENCE|)))
Added: clfswm/contrib/server/md5.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/md5.lisp Thu Aug 12 17:30:52 2010
@@ -0,0 +1,750 @@
+;;;; This file implements The MD5 Message-Digest Algorithm, as defined in
+;;;; RFC 1321 by R. Rivest, published April 1992.
+;;;;
+;;;; It was written by Pierre R. Mai, with copious input from the
+;;;; cmucl-help mailing-list hosted at cons.org, in November 2001 and
+;;;; has been placed into the public domain.
+;;;;
+;;;; While the implementation should work on all conforming Common
+;;;; Lisp implementations, it has only been optimized for CMU CL,
+;;;; where it achieved comparable performance to the standard md5sum
+;;;; utility (within a factor of 1.5 or less on iA32 and UltraSparc
+;;;; hardware).
+;;;;
+;;;; Since the implementation makes heavy use of arithmetic on
+;;;; (unsigned-byte 32) numbers, acceptable performance is likely only
+;;;; on CL implementations that support unboxed arithmetic on such
+;;;; numbers in some form. For other CL implementations a 16bit
+;;;; implementation of MD5 is probably more suitable.
+;;;;
+;;;; The code implements correct operation for files of unbounded size
+;;;; as is, at the cost of having to do a single generic integer
+;;;; addition for each call to update-md5-state. If you call
+;;;; update-md5-state frequently with little data, this can pose a
+;;;; performance problem. If you can live with a size restriction of
+;;;; 512 MB, then you can enable fast fixnum arithmetic by putting
+;;;; :md5-small-length onto *features* prior to compiling this file.
+;;;;
+;;;; Testing code can be compiled by including :md5-testing on
+;;;; *features* prior to compilation. In that case evaluating
+;;;; (md5::test-rfc1321) will run all the test-cases present in
+;;;; Appendix A.5 of RFC 1321 and report on the results.
+;;;; Evaluating (md5::test-other) will run further test-cases
+;;;; gathered by the author to cover regressions, etc.
+;;;;
+;;;; This software is "as is", and has no warranty of any kind. The
+;;;; authors assume no responsibility for the consequences of any use
+;;;; of this software.
+
+(defpackage #:md5 (:use #:cl)
+ (:export
+ ;; Low-Level types and functions
+ #:md5-regs #:initial-md5-regs #:md5regs-digest
+ #:update-md5-block #:fill-block #:fill-block-ub8 #:fill-block-char
+ ;; Mid-Level types and functions
+ #:md5-state #:md5-state-p #:make-md5-state
+ #:update-md5-state #:finalize-md5-state
+ ;; High-Level functions on sequences, streams and files
+ #:md5sum-sequence #:md5sum-stream #:md5sum-file
+ ;; Very High level functions
+ #:md5))
+
+(in-package #:md5)
+
+#+cmu
+(eval-when (:compile-toplevel)
+ (defparameter *old-expansion-limit* ext:*inline-expansion-limit*)
+ (setq ext:*inline-expansion-limit* (max ext:*inline-expansion-limit* 1000)))
+
+#+cmu
+(eval-when (:compile-toplevel :execute)
+ (defparameter *old-features* *features*)
+ (pushnew (c:backend-byte-order c:*target-backend*) *features*))
+
+;;; Section 2: Basic Datatypes
+
+#-lispworks
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (deftype ub32 ()
+ "Corresponds to the 32bit quantity word of the MD5 Spec"
+ `(unsigned-byte 32)))
+
+#+lispworks
+(deftype ub32 ()
+ "Corresponds to the 32bit quantity word of the MD5 Spec"
+ `(unsigned-byte 32))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defmacro assemble-ub32 (a b c d)
+ "Assemble an ub32 value from the given (unsigned-byte 8) values,
+where a is the intended low-order byte and d the high-order byte."
+ `(the ub32 (logior (ash ,d 24) (ash ,c 16) (ash ,b 8) ,a))))
+
+;;; Section 3.4: Auxilliary functions
+
+(declaim (inline f g h i)
+ (ftype (function (ub32 ub32 ub32) ub32) f g h i))
+
+(defun f (x y z)
+ (declare (type ub32 x y z)
+ (optimize (speed 3) (safety 0) (space 0) (debug 0)))
+ #+cmu
+ (kernel:32bit-logical-or (kernel:32bit-logical-and x y)
+ (kernel:32bit-logical-andc1 x z))
+ #-cmu
+ (logior (logand x y) (logandc1 x z)))
+
+(defun g (x y z)
+ (declare (type ub32 x y z)
+ (optimize (speed 3) (safety 0) (space 0) (debug 0)))
+ #+cmu
+ (kernel:32bit-logical-or (kernel:32bit-logical-and x z)
+ (kernel:32bit-logical-andc2 y z))
+ #-cmu
+ (logior (logand x z) (logandc2 y z)))
+
+(defun h (x y z)
+ (declare (type ub32 x y z)
+ (optimize (speed 3) (safety 0) (space 0) (debug 0)))
+ #+cmu
+ (kernel:32bit-logical-xor x (kernel:32bit-logical-xor y z))
+ #-cmu
+ (logxor x y z))
+
+(defun i (x y z)
+ (declare (type ub32 x y z)
+ (optimize (speed 3) (safety 0) (space 0) (debug 0)))
+ #+cmu
+ (kernel:32bit-logical-xor y (kernel:32bit-logical-orc2 x z))
+ #-cmu
+ (ldb (byte 32 0) (logxor y (logorc2 x z))))
+
+(declaim (inline mod32+)
+ (ftype (function (ub32 ub32) ub32) mod32+))
+(defun mod32+ (a b)
+ (declare (type ub32 a b) (optimize (speed 3) (safety 0) (space 0) (debug 0)))
+ (ldb (byte 32 0) (+ a b)))
+
+#+cmu
+(define-compiler-macro mod32+ (a b)
+ `(ext:truly-the ub32 (+ ,a ,b)))
+
+(declaim (inline rol32)
+ (ftype (function (ub32 (unsigned-byte 5)) ub32) rol32))
+(defun rol32 (a s)
+ (declare (type ub32 a) (type (unsigned-byte 5) s)
+ (optimize (speed 3) (safety 0) (space 0) (debug 0)))
+ #+cmu
+ (kernel:32bit-logical-or #+little-endian (kernel:shift-towards-end a s)
+ #+big-endian (kernel:shift-towards-start a s)
+ (ash a (- s 32)))
+ #-cmu
+ (logior (ldb (byte 32 0) (ash a s)) (ash a (- s 32))))
+
+;;; Section 3.4: Table T
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter *t* (make-array 64 :element-type 'ub32
+ :initial-contents
+ (loop for i from 1 to 64
+ collect
+ (truncate
+ (* 4294967296
+ (abs (sin (float i 0.0d0)))))))))
+
+;;; Section 3.4: Helper Macro for single round definitions
+
+(defmacro with-md5-round ((op block) &rest clauses)
+ (loop for (a b c d k s i) in clauses
+ collect
+ `(setq ,a (mod32+ ,b (rol32 (mod32+ (mod32+ ,a (,op ,b ,c ,d))
+ (mod32+ (aref ,block ,k)
+ ,(aref *t* (1- i))))
+ ,s)))
+ into result
+ finally
+ (return `(progn , at result))))
+
+;;; Section 3.3: (Initial) MD5 Working Set
+
+(deftype md5-regs ()
+ "The working state of the MD5 algorithm, which contains the 4 32-bit
+registers A, B, C and D."
+ `(simple-array (unsigned-byte 32) (4)))
+
+(defmacro md5-regs-a (regs)
+ `(aref ,regs 0))
+
+(defmacro md5-regs-b (regs)
+ `(aref ,regs 1))
+
+(defmacro md5-regs-c (regs)
+ `(aref ,regs 2))
+
+(defmacro md5-regs-d (regs)
+ `(aref ,regs 3))
+
+(defconstant +md5-magic-a+ (assemble-ub32 #x01 #x23 #x45 #x67)
+ "Initial value of Register A of the MD5 working state.")
+(defconstant +md5-magic-b+ (assemble-ub32 #x89 #xab #xcd #xef)
+ "Initial value of Register B of the MD5 working state.")
+(defconstant +md5-magic-c+ (assemble-ub32 #xfe #xdc #xba #x98)
+ "Initial value of Register C of the MD5 working state.")
+(defconstant +md5-magic-d+ (assemble-ub32 #x76 #x54 #x32 #x10)
+ "Initial value of Register D of the MD5 working state.")
+
+(declaim (inline initial-md5-regs))
+(defun initial-md5-regs ()
+ "Create the initial working state of an MD5 run."
+ (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))
+ (let ((regs (make-array 4 :element-type '(unsigned-byte 32))))
+ (declare (type md5-regs regs))
+ (setf (md5-regs-a regs) +md5-magic-a+
+ (md5-regs-b regs) +md5-magic-b+
+ (md5-regs-c regs) +md5-magic-c+
+ (md5-regs-d regs) +md5-magic-d+)
+ regs))
+
+;;; Section 3.4: Operation on 16-Word Blocks
+
+(defun update-md5-block (regs block)
+ "This is the core part of the MD5 algorithm. It takes a complete 16
+word block of input, and updates the working state in A, B, C, and D
+accordingly."
+ (declare (type md5-regs regs)
+ (type (simple-array ub32 (16)) block)
+ (optimize (speed 3) (safety 0) (space 0) (debug 0)))
+ (let ((A (md5-regs-a regs)) (B (md5-regs-b regs))
+ (C (md5-regs-c regs)) (D (md5-regs-d regs)))
+ (declare (type ub32 A B C D))
+ ;; Round 1
+ (with-md5-round (f block)
+ (A B C D 0 7 1)(D A B C 1 12 2)(C D A B 2 17 3)(B C D A 3 22 4)
+ (A B C D 4 7 5)(D A B C 5 12 6)(C D A B 6 17 7)(B C D A 7 22 8)
+ (A B C D 8 7 9)(D A B C 9 12 10)(C D A B 10 17 11)(B C D A 11 22 12)
+ (A B C D 12 7 13)(D A B C 13 12 14)(C D A B 14 17 15)(B C D A 15 22 16))
+ ;; Round 2
+ (with-md5-round (g block)
+ (A B C D 1 5 17)(D A B C 6 9 18)(C D A B 11 14 19)(B C D A 0 20 20)
+ (A B C D 5 5 21)(D A B C 10 9 22)(C D A B 15 14 23)(B C D A 4 20 24)
+ (A B C D 9 5 25)(D A B C 14 9 26)(C D A B 3 14 27)(B C D A 8 20 28)
+ (A B C D 13 5 29)(D A B C 2 9 30)(C D A B 7 14 31)(B C D A 12 20 32))
+ ;; Round 3
+ (with-md5-round (h block)
+ (A B C D 5 4 33)(D A B C 8 11 34)(C D A B 11 16 35)(B C D A 14 23 36)
+ (A B C D 1 4 37)(D A B C 4 11 38)(C D A B 7 16 39)(B C D A 10 23 40)
+ (A B C D 13 4 41)(D A B C 0 11 42)(C D A B 3 16 43)(B C D A 6 23 44)
+ (A B C D 9 4 45)(D A B C 12 11 46)(C D A B 15 16 47)(B C D A 2 23 48))
+ ;; Round 4
+ (with-md5-round (i block)
+ (A B C D 0 6 49)(D A B C 7 10 50)(C D A B 14 15 51)(B C D A 5 21 52)
+ (A B C D 12 6 53)(D A B C 3 10 54)(C D A B 10 15 55)(B C D A 1 21 56)
+ (A B C D 8 6 57)(D A B C 15 10 58)(C D A B 6 15 59)(B C D A 13 21 60)
+ (A B C D 4 6 61)(D A B C 11 10 62)(C D A B 2 15 63)(B C D A 9 21 64))
+ ;; Update and return
+ (setf (md5-regs-a regs) (mod32+ (md5-regs-a regs) A)
+ (md5-regs-b regs) (mod32+ (md5-regs-b regs) B)
+ (md5-regs-c regs) (mod32+ (md5-regs-c regs) C)
+ (md5-regs-d regs) (mod32+ (md5-regs-d regs) D))
+ regs))
+
+;;; Section 3.4: Converting 8bit-vectors into 16-Word Blocks
+
+(declaim (inline fill-block fill-block-ub8 fill-block-char))
+
+(defun fill-block-ub8 (block buffer offset)
+ "Convert a complete 64 (unsigned-byte 8) input vector segment
+starting from offset into the given 16 word MD5 block."
+ (declare (type (integer 0 #.(- most-positive-fixnum 64)) offset)
+ (type (simple-array ub32 (16)) block)
+ (type (simple-array (unsigned-byte 8) (*)) buffer)
+ (optimize (speed 3) (safety 0) (space 0) (debug 0)))
+;; #+(and :cmu :little-endian)
+;; (kernel:bit-bash-copy ;; There is a problem with this specific code (PBrochard)
+;; buffer (+ (* vm:vector-data-offset vm:word-bits) (* offset vm:byte-bits))
+;; block (* vm:vector-data-offset vm:word-bits)
+;; (* 64 vm:byte-bits))
+;; #-(and :cmu :little-endian)
+ (loop for i of-type (integer 0 16) from 0
+ for j of-type (integer 0 #.most-positive-fixnum)
+ from offset to (+ offset 63) by 4
+ do
+ (setf (aref block i)
+ (assemble-ub32 (aref buffer j)
+ (aref buffer (+ j 1))
+ (aref buffer (+ j 2))
+ (aref buffer (+ j 3))))))
+
+(defun fill-block-char (block buffer offset)
+ "Convert a complete 64 character input string segment starting from
+offset into the given 16 word MD5 block."
+ (declare (type (integer 0 #.(- most-positive-fixnum 64)) offset)
+ (type (simple-array ub32 (16)) block)
+ (type simple-string buffer)
+ (optimize (speed 3) (safety 0) (space 0) (debug 0)))
+;; #+(and :cmu :little-endian)
+;; (kernel:bit-bash-copy ;; There is a problem with this specific code (PBrochard)
+;; buffer (+ (* vm:vector-data-offset vm:word-bits) (* offset vm:byte-bits))
+;; block (* vm:vector-data-offset vm:word-bits)
+;; (* 64 vm:byte-bits))
+;; #-(and :cmu :little-endian)
+ (loop for i of-type (integer 0 16) from 0
+ for j of-type (integer 0 #.most-positive-fixnum)
+ from offset to (+ offset 63) by 4
+ do
+ (setf (aref block i)
+ (assemble-ub32 (char-code (schar buffer j))
+ (char-code (schar buffer (+ j 1)))
+ (char-code (schar buffer (+ j 2)))
+ (char-code (schar buffer (+ j 3)))))))
+
+(defun fill-block (block buffer offset)
+ "Convert a complete 64 byte input vector segment into the given 16
+word MD5 block. This currently works on (unsigned-byte 8) and
+character simple-arrays, via the functions `fill-block-ub8' and
+`fill-block-char' respectively."
+ (declare (type (integer 0 #.(- most-positive-fixnum 64)) offset)
+ (type (simple-array ub32 (16)) block)
+ (type (simple-array * (*)) buffer)
+ (optimize (speed 3) (safety 0) (space 0) (debug 0)))
+ (etypecase buffer
+ ((simple-array (unsigned-byte 8) (*))
+ (fill-block-ub8 block buffer offset))
+ (simple-string
+ (fill-block-char block buffer offset))))
+
+;;; Section 3.5: Message Digest Output
+
+(declaim (inline md5regs-digest))
+(defun md5regs-digest (regs)
+ "Create the final 16 byte message-digest from the MD5 working state
+in regs. Returns a (simple-array (unsigned-byte 8) (16))."
+ (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))
+ (type md5-regs regs))
+ (let ((result (make-array 16 :element-type '(unsigned-byte 8))))
+ (declare (type (simple-array (unsigned-byte 8) (16)) result))
+ (macrolet ((frob (reg offset)
+ (let ((var (gensym)))
+ `(let ((,var ,reg))
+ (declare (type ub32 ,var))
+ (setf
+ (aref result ,offset) (ldb (byte 8 0) ,var)
+ (aref result ,(+ offset 1)) (ldb (byte 8 8) ,var)
+ (aref result ,(+ offset 2)) (ldb (byte 8 16) ,var)
+ (aref result ,(+ offset 3)) (ldb (byte 8 24) ,var))))))
+ (frob (md5-regs-a regs) 0)
+ (frob (md5-regs-b regs) 4)
+ (frob (md5-regs-c regs) 8)
+ (frob (md5-regs-d regs) 12))
+ result))
+
+;;; Mid-Level Drivers
+
+(defstruct (md5-state
+ (:constructor make-md5-state ())
+ (:copier))
+ (regs (initial-md5-regs) :type md5-regs :read-only t)
+ (amount 0 :type
+ #-md5-small-length (integer 0 *)
+ #+md5-small-length (unsigned-byte 29))
+ (block (make-array 16 :element-type '(unsigned-byte 32)) :read-only t
+ :type (simple-array (unsigned-byte 32) (16)))
+ (buffer (make-array 64 :element-type '(unsigned-byte 8)) :read-only t
+ :type (simple-array (unsigned-byte 8) (64)))
+ (buffer-index 0 :type (integer 0 63))
+ (finalized-p nil))
+
+(declaim (inline copy-to-buffer))
+(defun copy-to-buffer (from from-offset count buffer buffer-offset)
+ "Copy a partial segment from input vector from starting at
+from-offset and copying count elements into the 64 byte buffer
+starting at buffer-offset."
+ (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))
+ (type (unsigned-byte 29) from-offset)
+ (type (integer 0 63) count buffer-offset)
+ (type (simple-array * (*)) from)
+ (type (simple-array (unsigned-byte 8) (64)) buffer))
+;; #+cmu
+;; (kernel:bit-bash-copy ;; There is a problem with this specific code (PBrochard)
+;; from (+ (* vm:vector-data-offset vm:word-bits) (* from-offset vm:byte-bits))
+;; buffer (+ (* vm:vector-data-offset vm:word-bits)
+;; (* buffer-offset vm:byte-bits))
+;; (* count vm:byte-bits))
+;; #-cmu
+ (etypecase from
+ (simple-string
+ (loop for buffer-index of-type (integer 0 64) from buffer-offset
+ for from-index of-type fixnum from from-offset
+ below (+ from-offset count)
+ do
+ (setf (aref buffer buffer-index)
+ (char-code (schar (the simple-string from) from-index)))))
+ ((simple-array (unsigned-byte 8) (*))
+ (loop for buffer-index of-type (integer 0 64) from buffer-offset
+ for from-index of-type fixnum from from-offset
+ below (+ from-offset count)
+ do
+ (setf (aref buffer buffer-index)
+ (aref (the (simple-array (unsigned-byte 8) (*)) from)
+ from-index))))))
+
+(defun update-md5-state (state sequence &key (start 0) (end (length sequence)))
+ "Update the given md5-state from sequence, which is either a
+simple-string or a simple-array with element-type (unsigned-byte 8),
+bounded by start and end, which must be numeric bounding-indices."
+ (declare (type md5-state state)
+ (type (simple-array * (*)) sequence)
+ (type fixnum start end)
+ (optimize (speed 3) #+cmu (safety 0) (space 0) (debug 0))
+ #+cmu
+ (ext:optimize-interface (safety 1) (debug 1)))
+ (let ((regs (md5-state-regs state))
+ (block (md5-state-block state))
+ (buffer (md5-state-buffer state)))
+ (declare (type md5-regs regs)
+ (type (simple-array (unsigned-byte 32) (16)) block)
+ (type (simple-array (unsigned-byte 8) (64)) buffer))
+ ;; Handle old rest
+ (unless (zerop (md5-state-buffer-index state))
+ (let* ((buffer-index (md5-state-buffer-index state))
+ (remainder (- 64 buffer-index))
+ (length (- end start))
+ (amount (min remainder length)))
+ (declare (type (integer 0 63) buffer-index remainder amount)
+ (type fixnum length))
+ (copy-to-buffer sequence start amount buffer buffer-index)
+ (setf (md5-state-amount state)
+ #-md5-small-length (+ (md5-state-amount state) amount)
+ #+md5-small-length (the (unsigned-byte 29)
+ (+ (md5-state-amount state) amount)))
+ (setq start (the fixnum (+ start amount)))
+ (if (< length remainder)
+ (setf (md5-state-buffer-index state)
+ (the (integer 0 63) (+ buffer-index amount)))
+ (progn
+ (fill-block-ub8 block buffer 0)
+ (update-md5-block regs block)
+ (setf (md5-state-buffer-index state) 0)))))
+ ;; Leave when nothing to do
+ (when (>= start end)
+ (return-from update-md5-state state))
+ ;; Handle main-part and new-rest
+ (etypecase sequence
+ ((simple-array (unsigned-byte 8) (*))
+ (locally
+ (declare (type (simple-array (unsigned-byte 8) (*)) sequence))
+ (loop for offset of-type (unsigned-byte 29) from start below end by 64
+ until (< (- end offset) 64)
+ do
+ (fill-block-ub8 block sequence offset)
+ (update-md5-block regs block)
+ finally
+ (let ((amount (- end offset)))
+ (unless (zerop amount)
+ (copy-to-buffer sequence offset amount buffer 0))
+ (setf (md5-state-buffer-index state) amount)))))
+ (simple-string
+ (locally
+ (declare (type simple-string sequence))
+ (loop for offset of-type (unsigned-byte 29) from start below end by 64
+ until (< (- end offset) 64)
+ do
+ (fill-block-char block sequence offset)
+ (update-md5-block regs block)
+ finally
+ (let ((amount (- end offset)))
+ (unless (zerop amount)
+ (copy-to-buffer sequence offset amount buffer 0))
+ (setf (md5-state-buffer-index state) amount))))))
+ (setf (md5-state-amount state)
+ #-md5-small-length (+ (md5-state-amount state)
+ (the fixnum (- end start)))
+ #+md5-small-length (the (unsigned-byte 29)
+ (+ (md5-state-amount state)
+ (the fixnum (- end start)))))
+ state))
+
+(defun finalize-md5-state (state)
+ "If the given md5-state has not already been finalized, finalize it,
+by processing any remaining input in its buffer, with suitable padding
+and appended bit-length, as specified by the MD5 standard.
+
+The resulting MD5 message-digest is returned as an array of sixteen
+(unsigned-byte 8) values. Calling `update-md5-state' after a call to
+`finalize-md5-state' results in unspecified behaviour."
+ (declare (type md5-state state)
+ (optimize (speed 3) #+cmu (safety 0) (space 0) (debug 0))
+ #+cmu
+ (ext:optimize-interface (safety 1) (debug 1)))
+ (or (md5-state-finalized-p state)
+ (let ((regs (md5-state-regs state))
+ (block (md5-state-block state))
+ (buffer (md5-state-buffer state))
+ (buffer-index (md5-state-buffer-index state))
+ (total-length (* 8 (md5-state-amount state))))
+ (declare (type md5-regs regs)
+ (type (integer 0 63) buffer-index)
+ (type (simple-array ub32 (16)) block)
+ (type (simple-array (unsigned-byte 8) (*)) buffer))
+ ;; Add mandatory bit 1 padding
+ (setf (aref buffer buffer-index) #x80)
+ ;; Fill with 0 bit padding
+ (loop for index of-type (integer 0 64)
+ from (1+ buffer-index) below 64
+ do (setf (aref buffer index) #x00))
+ (fill-block-ub8 block buffer 0)
+ ;; Flush block first if length wouldn't fit
+ (when (>= buffer-index 56)
+ (update-md5-block regs block)
+ ;; Create new fully 0 padded block
+ (loop for index of-type (integer 0 16) from 0 below 16
+ do (setf (aref block index) #x00000000)))
+ ;; Add 64bit message bit length
+ (setf (aref block 14) (ldb (byte 32 0) total-length))
+ #-md5-small-length
+ (setf (aref block 15) (ldb (byte 32 32) total-length))
+ ;; Flush last block
+ (update-md5-block regs block)
+ ;; Done, remember digest for later calls
+ (setf (md5-state-finalized-p state)
+ (md5regs-digest regs)))))
+
+;;; High-Level Drivers
+
+(defun md5sum-sequence (sequence &key (start 0) end)
+ "Calculate the MD5 message-digest of data in sequence. On CMU CL
+this works for all sequences whose element-type is supported by the
+underlying MD5 routines, on other implementations it only works for 1d
+simple-arrays with such element types."
+ (declare (optimize (speed 3) (space 0) (debug 0))
+ (type vector sequence) (type fixnum start))
+ (let ((state (make-md5-state)))
+ (declare (type md5-state state))
+ #+cmu
+ (lisp::with-array-data ((data sequence) (real-start start) (real-end end))
+ (update-md5-state state data :start real-start :end real-end))
+ #-cmu
+ (let ((real-end (or end (length sequence))))
+ (declare (type fixnum real-end))
+ (update-md5-state state sequence :start start :end real-end))
+ (finalize-md5-state state)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defconstant +buffer-size+ (* 128 1024)
+ "Size of internal buffer to use for md5sum-stream and md5sum-file
+operations. This should be a multiple of 64, the MD5 block size."))
+
+(deftype buffer-index () `(integer 0 ,+buffer-size+))
+
+(defun md5sum-stream (stream)
+ "Calculate an MD5 message-digest of the contents of stream. Its
+element-type has to be either (unsigned-byte 8) or character."
+ (declare (optimize (speed 3) (space 0) (debug 0)))
+ (let ((state (make-md5-state)))
+ (declare (type md5-state state))
+ (cond
+ ((equal (stream-element-type stream) '(unsigned-byte 8))
+ (let ((buffer (make-array +buffer-size+
+ :element-type '(unsigned-byte 8))))
+ (declare (type (simple-array (unsigned-byte 8) (#.+buffer-size+))
+ buffer))
+ (loop for bytes of-type buffer-index = (read-sequence buffer stream)
+ do (update-md5-state state buffer :end bytes)
+ until (< bytes +buffer-size+)
+ finally
+ (return (finalize-md5-state state)))))
+ ((equal (stream-element-type stream) 'character)
+ (let ((buffer (make-string +buffer-size+)))
+ (declare (type (simple-string #.+buffer-size+) buffer))
+ (loop for bytes of-type buffer-index = (read-sequence buffer stream)
+ do (update-md5-state state buffer :end bytes)
+ until (< bytes +buffer-size+)
+ finally
+ (return (finalize-md5-state state)))))
+ (t
+ (error "Unsupported stream element-type ~S for stream ~S."
+ (stream-element-type stream) stream)))))
+
+(defun md5sum-file (pathname)
+ "Calculate the MD5 message-digest of the file specified by pathname."
+ (declare (optimize (speed 3) (space 0) (debug 0)))
+ (with-open-file (stream pathname :element-type '(unsigned-byte 8))
+ (md5sum-stream stream)))
+
+
+
+(defun md5-string (md5-digest)
+ (format nil "~(~{~2,'0X~}~)"
+ (map 'list #'identity md5-digest)))
+
+
+(defun md5 (sequence)
+ (md5-string (md5sum-sequence sequence)))
+
+
+
+#+md5-testing
+(defconstant +rfc1321-testsuite+
+ '(("" . "d41d8cd98f00b204e9800998ecf8427e")
+ ("a" ."0cc175b9c0f1b6a831c399e269772661")
+ ("abc" . "900150983cd24fb0d6963f7d28e17f72")
+ ("message digest" . "f96b697d7cb7938d525a2f31aaf161d0")
+ ("abcdefghijklmnopqrstuvwxyz" . "c3fcd3d76192e4007dfb496cca67e13b")
+ ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" .
+ "d174ab98d277d9f5a5611c2c9f419d9f")
+ ("12345678901234567890123456789012345678901234567890123456789012345678901234567890" .
+ "57edf4a22be3c955ac49da2e2107b67a"))
+ "AList of test input strings and stringified message-digests
+according to the test suite in Appendix A.5 of RFC 1321")
+
+#+md5-testing
+(defconstant +other-testsuite+
+ '(;; From padding bug report by Edi Weitz
+ ("1631901HERR BUCHHEISTERCITROEN NORD1043360796beckenbauer" .
+ "d734945e5930bb28859ccd13c830358b")
+ ;; Test padding for strings from 0 to 69*8 bits in size.
+ ("" . "d41d8cd98f00b204e9800998ecf8427e")
+ ("a" . "0cc175b9c0f1b6a831c399e269772661")
+ ("aa" . "4124bc0a9335c27f086f24ba207a4912")
+ ("aaa" . "47bce5c74f589f4867dbd57e9ca9f808")
+ ("aaaa" . "74b87337454200d4d33f80c4663dc5e5")
+ ("aaaaa" . "594f803b380a41396ed63dca39503542")
+ ("aaaaaa" . "0b4e7a0e5fe84ad35fb5f95b9ceeac79")
+ ("aaaaaaa" . "5d793fc5b00a2348c3fb9ab59e5ca98a")
+ ("aaaaaaaa" . "3dbe00a167653a1aaee01d93e77e730e")
+ ("aaaaaaaaa" . "552e6a97297c53e592208cf97fbb3b60")
+ ("aaaaaaaaaa" . "e09c80c42fda55f9d992e59ca6b3307d")
+ ("aaaaaaaaaaa" . "d57f21e6a273781dbf8b7657940f3b03")
+ ("aaaaaaaaaaaa" . "45e4812014d83dde5666ebdf5a8ed1ed")
+ ("aaaaaaaaaaaaa" . "c162de19c4c3731ca3428769d0cd593d")
+ ("aaaaaaaaaaaaaa" . "451599a5f9afa91a0f2097040a796f3d")
+ ("aaaaaaaaaaaaaaa" . "12f9cf6998d52dbe773b06f848bb3608")
+ ("aaaaaaaaaaaaaaaa" . "23ca472302f49b3ea5592b146a312da0")
+ ("aaaaaaaaaaaaaaaaa" . "88e42e96cc71151b6e1938a1699b0a27")
+ ("aaaaaaaaaaaaaaaaaa" . "2c60c24e7087e18e45055a33f9a5be91")
+ ("aaaaaaaaaaaaaaaaaaa" . "639d76897485360b3147e66e0a8a3d6c")
+ ("aaaaaaaaaaaaaaaaaaaa" . "22d42eb002cefa81e9ad604ea57bc01d")
+ ("aaaaaaaaaaaaaaaaaaaaa" . "bd049f221af82804c5a2826809337c9b")
+ ("aaaaaaaaaaaaaaaaaaaaaa" . "ff49cfac3968dbce26ebe7d4823e58bd")
+ ("aaaaaaaaaaaaaaaaaaaaaaa" . "d95dbfee231e34cccb8c04444412ed7d")
+ ("aaaaaaaaaaaaaaaaaaaaaaaa" . "40edae4bad0e5bf6d6c2dc5615a86afb")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaa" . "a5a8bfa3962f49330227955e24a2e67c")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaa" . "ae791f19bdf77357ff10bb6b0e97e121")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaa" . "aaab9c59a88bf0bdfcb170546c5459d6")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "b0f0545856af1a340acdedce23c54b97")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "f7ce3d7d44f3342107d884bfa90c966a")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "59e794d45697b360e18ba972bada0123")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "3b0845db57c200be6052466f87b2198a")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "5eca9bd3eb07c006cd43ae48dfde7fd3")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "b4f13cb081e412f44e99742cb128a1a5")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "4c660346451b8cf91ef50f4634458d41")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "11db24dc3f6c2145701db08625dd6d76")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "80dad3aad8584778352c68ab06250327")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "1227fe415e79db47285cb2689c93963f")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "8e084f489f1bdf08c39f98ff6447ce6d")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "08b2f2b0864bac1ba1585043362cbec9")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "4697843037d962f62a5a429e611e0f5f")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "10c4da18575c092b486f8ab96c01c02f")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "af205d729450b663f48b11d839a1c8df")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "0d3f91798fac6ee279ec2485b25f1124")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "4c3c7c067634daec9716a80ea886d123")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "d1e358e6e3b707282cdd06e919f7e08c")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "8c6ded4f0af86e0a7e301f8a716c4363")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "4c2d8bcb02d982d7cb77f649c0a2dea8")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "bdb662f765cd310f2a547cab1cfecef6")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "08ff5f7301d30200ab89169f6afdb7af")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "6eb6a030bcce166534b95bc2ab45d9cf")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "1bb77918e5695c944be02c16ae29b25e")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "b6fe77c19f0f0f4946c761d62585bfea")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "e9e7e260dce84ffa6e0e7eb5fd9d37fc")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "eced9e0b81ef2bba605cbc5e2e76a1d0")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "ef1772b6dff9a122358552954ad0df65")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "3b0c8ac703f828b04c6c197006d17218")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "652b906d60af96844ebd21b674f35e93")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "dc2f2f2462a0d72358b2f99389458606")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "762fc2665994b217c52c3c2eb7d9f406")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "cc7ed669cf88f201c3297c6a91e1d18d")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "cced11f7bbbffea2f718903216643648")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "24612f0ce2c9d2cf2b022ef1e027a54f")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "b06521f39153d618550606be297466d5")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "014842d480b571495a4a0363793f7367")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "c743a45e0d2e6a95cb859adae0248435")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "def5d97e01e1219fb2fc8da6c4d6ba2f")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "92cb737f8687ccb93022fdb411a77cca")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "a0d1395c7fb36247bfe2d49376d9d133")
+ ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" .
+ "ab75504250558b788f99d1ebd219abf2"))
+ "AList of test input strings and stringified message-digests
+according to my additional test suite")
+
+#+md5-testing
+(defun test-with-testsuite (testsuite)
+ (loop for count from 1
+ for (source . md5-string) in testsuite
+ for md5-digest = (md5sum-sequence source)
+ for md5-result-string = (md5-string md5-digest)
+ do
+ (format
+ *trace-output*
+ "~2&Test-Case ~D:~% Input: ~S~% Required: ~A~% Returned: ~A~%"
+ count source md5-string md5-result-string)
+ when (string= md5-string md5-result-string)
+ do (format *trace-output* " OK~%")
+ else
+ count 1 into failed
+ and do (format *trace-output* " FAILED~%")
+ finally
+ (format *trace-output*
+ "~2&~[All ~D test cases succeeded~:;~:*~D of ~D test cases failed~].~%"
+ failed (1- count))
+ (return (zerop failed))))
+
+#+md5-testing
+(defun test-rfc1321 ()
+ (test-with-testsuite +rfc1321-testsuite+))
+
+#+md5-testing
+(defun test-other ()
+ (test-with-testsuite +other-testsuite+))
+
+#+cmu
+(eval-when (:compile-toplevel :execute)
+ (setq *features* *old-features*))
+
+#+cmu
+(eval-when (:compile-toplevel)
+ (setq ext:*inline-expansion-limit* *old-expansion-limit*))
Added: clfswm/contrib/server/net.fas
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/net.fas Thu Aug 12 17:30:52 2010
@@ -0,0 +1,1042 @@
+(|SYSTEM|::|VERSION| '(20080430.))
+#0Y_ #0Y |CHARSET|::|UTF-8|
+#Y(#:|1 14 (IN-PACKAGE :CL-USER)-1|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA 31 F6 0F 01 19 01)
+ ("CL-USER" |COMMON-LISP|::|*PACKAGE*|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|26 57 (DEFPACKAGE :PORT (:USE :COMMON-LISP) ...)-3-1|
+ #18Y(00 00 00 00 00 00 00 00 20 01 DA 01 04 31 F0 3E 19 01) ("PORT")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|26 57 (DEFPACKAGE :PORT (:USE :COMMON-LISP) ...)-3-2|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA DB 31 EC 3E 19 01)
+ (("COMMON-LISP") "PORT")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|26 57 (DEFPACKAGE :PORT (:USE :COMMON-LISP) ...)-3-3|
+ #19Y(00 00 00 00 00 00 00 00 20 01 DA DB 63 2D 03 02 3E 19 01)
+ (("RESOLVE-HOST-IPADDR" "IPADDR-TO-DOTTED" "DOTTED-TO-IPADDR"
+ "IPADDR-CLOSURE" "HOSTENT" "HOSTENT-NAME" "HOSTENT-ALIASES"
+ "HOSTENT-ADDR-LIST" "HOSTENT-ADDR-TYPE" "SOCKET" "OPEN-SOCKET"
+ "SOCKET-HOST/PORT" "SOCKET-STRING" "SOCKET-SERVER"
+ "SET-SOCKET-STREAM-FORMAT" "SOCKET-ACCEPT" "OPEN-SOCKET-SERVER"
+ "SOCKET-SERVER-CLOSE" "SOCKET-SERVER-HOST/PORT" "SOCKET-SERVICE-PORT"
+ "SERVENT-NAME" "SERVENT-ALIASES" "SERVENT-PORT" "SERVENT-PROTO"
+ "SERVENT-P" "SERVENT" "NETWORK" "TIMEOUT" "LOGIN" "NET-PATH")
+ "PORT" |SYSTEM|::|INTERN-EXPORT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|26 57 (DEFPACKAGE :PORT (:USE :COMMON-LISP) ...)-3-4|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 D9 19 01) ("PORT")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+#Y(#:|59 59 (IN-PACKAGE :PORT)-4|
+ #17Y(00 00 00 00 00 00 00 00 20 01 DA 31 F6 0F 01 19 01)
+ ("PORT" |COMMON-LISP|::|*PACKAGE*|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|62 71 (DEFINE-CONDITION CODE (ERROR) ...)-5-1|
+ #94Y(00 00 00 00 00 00 00 00 20 01 6B 00 99 01 DC DD DE 7B 01 DF E0 E1 E2 E3
+ E4 E5 E6 63 E7 63 6F 0E 7B 0A E0 E9 E2 EA E4 EB E6 63 E7 63 6F 0E EC ED
+ 7B 0C E0 EE E2 EF E4 F0 E6 63 E7 63 6F 0E EC F1 7B 0C 7B 03 F2 B3 F3 F4
+ F5 F6 63 F7 64 7B 04 33 02 23 37 09 16 01 DC 38 02 32 3A 3E 19 01)
+ (|CLOS|::|<STANDARD-CLASS>| |CLOS|::|ENSURE-CLASS| |PORT|::|CODE|
+ :|DIRECT-SUPERCLASSES| |COMMON-LISP|::|ERROR| :|DIRECT-SLOTS| :|NAME|
+ |PORT|::|PROC| :|READERS| (|PORT|::|CODE-PROC|) :|INITARGS| (:|PROC|)
+ :|INITFORM| :|INITFUNCTION| |SYSTEM|::|MAKE-CONSTANT-INITFUNCTION|
+ |PORT|::|MESG| (|PORT|::|CODE-MESG|) (:|MESG|) :|TYPE|
+ (|COMMON-LISP|::|OR| |COMMON-LISP|::|NULL| |COMMON-LISP|::|SIMPLE-STRING|)
+ |PORT|::|ARGS| (|PORT|::|CODE-ARGS|) (:|ARGS|) |COMMON-LISP|::|LIST|
+ :|METACLASS| :|DOCUMENTATION| "An error in the user code."
+ (:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|) :|DIRECT-DEFAULT-INITARGS|
+ :|GENERIC-ACCESSORS|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|62 71 (DEFINE-CONDITION CODE (ERROR) ...)-5-2|
+ #49Y(00 00 00 00 00 00 00 00 20 01 DA DB 38 01 8F 9E 03 DA 2F 02 DA DD DE 63
+ DF E0 E1 E2 E3 E4 38 02 72 3A 64 38 02 72 3A 7B 02 7B 08 2D 03 0B 3E 19
+ 01)
+ (|CLOS|::|PRINT-OBJECT| |SYSTEM|::|TRACED-DEFINITION| |SYSTEM|::|UNTRACE1|
+ #Y(#:|62 71 (DEFINE-CONDITION CODE (ERROR) ...)-5-2-1|
+ #25Y(00 00 00 00 01 00 00 00 20 02 00 2B 01 7F 02 00 00 AC 6D 00 01 C6
+ 5D 19 03)
+ (#Y(#:|62 71 (DEFINE-CONDITION CODE (ERROR) ...)-5-2-1-1|
+ #55Y(00 00 00 00 03 00 00 00 20 04 0E 01 1C 1C 0E 02 1C 18 AD DE B0
+ 6F 05 B1 6F 06 B2 6F 07 2D 05 08 9F 19 04 14 AF AF 36 02 19 04
+ 92 03 76 69 00 01 AF AF 2D 03 03 19 04)
+ (|COMMON-LISP|::|NIL| |COMMON-LISP|::|*PRINT-ESCAPE*|
+ |COMMON-LISP|::|*PRINT-READABLY*| |CLOS|::|%NO-NEXT-METHOD|
+ #Y(#:|62 71 (DEFINE-CONDITION CODE (ERROR) ...)-5-2-1-1-1|
+ #58Y(00 00 00 00 02 00 00 00 21 18 DA B0 31 94 AF 2F 01 10 02 B1
+ B3 31 8D 11 AF 2F 03 DE B0 31 94 9E 5B 1C 05 83 01 9E 19 04
+ DF B0 31 94 AF 94 02 83 03 94 03 83 04 2D 03 06 1B 6B)
+ (#\[ |SYSTEM|::|STREAM-START-S-EXPRESSION|
+ |COMMON-LISP|::|*PRINT-RIGHT-MARGIN*|
+ |SYSTEM|::|STREAM-END-S-EXPRESSION| #\] #\Space
+ |SYSTEM|::|DO-FORMAT-INDIRECTION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |PORT|::|CODE-PROC| |PORT|::|CODE-MESG| |PORT|::|CODE-ARGS|
+ |COMMON-LISP|::|FORMAT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ (|COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ :|QUALIFIERS| :|LAMBDA-LIST|
+ (|COMMON-LISP|::|CONDITION| |COMMON-LISP|::|STREAM|) |CLOS|::|SIGNATURE|
+ #(2. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ :|SPECIALIZERS| |PORT|::|CODE| |CLOS|::|DO-DEFMETHOD|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|62 71 (DEFINE-CONDITION CODE (ERROR) ...)-5-3|
+ #13Y(00 00 00 00 00 00 00 00 20 01 C5 19 01) (|PORT|::|CODE|)
+ |COMMON-LISP|::|NIL|)
+#Y(#:|73 77 (DEFINE-CONDITION CASE-ERROR (CODE) ...)-6-1|
+ #62Y(00 00 00 00 00 00 00 00 20 01 6B 00 99 01 DC DD DE 7B 01 DF E0 E1 E2 E3
+ E4 E5 E6 E5 6F 0D E8 E9 7B 0A 7B 01 EA B3 EB EC ED EE 63 EF 64 7B 04 33
+ 02 23 37 09 16 01 DC 38 02 32 3A 3E 19 01)
+ (|CLOS|::|<STANDARD-CLASS>| |CLOS|::|ENSURE-CLASS| |PORT|::|CASE-ERROR|
+ :|DIRECT-SUPERCLASSES| |PORT|::|CODE| :|DIRECT-SLOTS| :|NAME|
+ |PORT|::|MESG| :|READERS| (|PORT|::|CODE-MESG|) :|INITFORM|
+ "`~s' evaluated to `~s', not one of [~@{`~s'~^ ~}]" :|INITFUNCTION|
+ |SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| :|TYPE|
+ |COMMON-LISP|::|SIMPLE-STRING| :|METACLASS| :|DOCUMENTATION|
+ "An error in a case statement.\n
+This carries the function name which makes the error message more useful."
+ (:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|) :|DIRECT-DEFAULT-INITARGS|
+ :|GENERIC-ACCESSORS|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|73 77 (DEFINE-CONDITION CASE-ERROR (CODE) ...)-6-2|
+ #13Y(00 00 00 00 00 00 00 00 20 01 C5 19 01) (|PORT|::|CASE-ERROR|)
+ |COMMON-LISP|::|NIL|)
+#Y(#:|80 85 (DEFINE-CONDITION NOT-IMPLEMENTED (CODE) ...)-7-1|
+ #74Y(00 00 00 00 00 00 00 00 20 01 6B 00 99 01 DC DD DE 7B 01 DF E0 E1 E2 E3
+ E4 E5 E6 E5 6F 0D E8 E9 7B 0A E0 EA E2 EB E4 EC E6 ED E8 EE 7B 0A 7B 02
+ EF B3 F0 F1 F2 F3 63 F4 64 7B 04 33 02 23 37 09 16 01 DC 38 02 32 3A 3E
+ 19 01)
+ (|CLOS|::|<STANDARD-CLASS>| |CLOS|::|ENSURE-CLASS| |PORT|::|NOT-IMPLEMENTED|
+ :|DIRECT-SUPERCLASSES| |PORT|::|CODE| :|DIRECT-SLOTS| :|NAME|
+ |PORT|::|MESG| :|READERS| (|PORT|::|CODE-MESG|) :|INITFORM|
+ "not implemented for ~a [~a]" :|INITFUNCTION|
+ |SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| :|TYPE|
+ |COMMON-LISP|::|SIMPLE-STRING| |PORT|::|ARGS| (|PORT|::|CODE-ARGS|)
+ (|COMMON-LISP|::|LIST| (|COMMON-LISP|::|LISP-IMPLEMENTATION-TYPE|)
+ (|COMMON-LISP|::|LISP-IMPLEMENTATION-VERSION|))
+ #Y(|PORT|::|DEFAULT-ARGS|
+ #18Y(00 00 00 00 00 00 00 00 26 01 71 CE 71 CF 61 02 19 01) ()
+ (|COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|) ()
+ |COMMON-LISP|::|NIL| 1)
+ |COMMON-LISP|::|LIST| :|METACLASS| :|DOCUMENTATION|
+ "Your implementation does not support this functionality."
+ (:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|) :|DIRECT-DEFAULT-INITARGS|
+ :|GENERIC-ACCESSORS|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|80 85 (DEFINE-CONDITION NOT-IMPLEMENTED (CODE) ...)-7-2|
+ #13Y(00 00 00 00 00 00 00 00 20 01 C5 19 01) (|PORT|::|NOT-IMPLEMENTED|)
+ |COMMON-LISP|::|NIL|)
+#Y(#:|88 95 (DEFMACRO WITH-GENSYMS (# &BODY BODY) ...)-8|
+ #23Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 72 4C 32 9C C5 19 01)
+ (|PORT|::|WITH-GENSYMS| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|WITH-GENSYMS|
+ #101Y(00 00 00 00 02 00 00 00 26 03 AE DA DA 64 2D 04 01 1D 19 9F 5C 78
+ AC DD DD 64 2D 04 01 1D 12 AC 94 00 95 01 A3 5C 79 E5 63 AF 1B 2A
+ AE 2F 02 19 03 DE DF B1 E0 B0 E1 6F 08 E3 B3 E4 33 07 1F 94 00 AC
+ E6 E7 B5 B0 72 A6 E8 73 03 26 7B 02 7B 02 84 02 16 01 83 00 AC 8D
+ 9F 65 16 01 AC 80 B1 00 9F 5D 5D 19 08)
+ (2. |SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|MACRO-CALL-ERROR| 1.
+ |EXT|::|SOURCE-PROGRAM-ERROR| :|FORM| :|DETAIL|
+ "~S: ~S does not match lambda list element ~:S" |SYSTEM|::|TEXT|
+ |PORT|::|WITH-GENSYMS|
+ #1=(|PORT|::|TITLE| |COMMON-LISP|::|&REST| |PORT|::|NAMES|)
+ |COMMON-LISP|::|LET| |COMMON-LISP|::|GENSYM| |COMMON-LISP|::|STRING|
+ "-")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ "Bind symbols in NAMES to gensyms. TITLE is a string - `gensym' prefix.\n
+Inspired by Paul Graham, <On Lisp>, p. 145."
+ 1)
+ (#1# |COMMON-LISP|::|&BODY| |PORT|::|BODY|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|97 104 (DEFMACRO DEFCONST (NAME TYPE INIT ...) ...)-9|
+ #23Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 72 4C 32 9C C5 19 01)
+ (|PORT|::|DEFCONST| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|DEFCONST|
+ #71Y(00 00 00 00 02 00 00 00 26 03 AE DA DA 63 2D 04 01 1D 2C 9F 5C 78
+ A0 5C 5C 78 A1 5C 5C 5C 78 B1 71 A2 DD DE DF B1 B3 7B 03 7B 02 B0
+ E0 8A 07 14 CE 14 B2 E4 B3 B3 7B 03 B1 7B 04 61 03 19 07 AE 2F 02
+ 19 03 CD 1B 6A)
+ (5. |SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|MACRO-CALL-ERROR|
+ |COMMON-LISP|::|PROGN| |COMMON-LISP|::|DECLAIM| |COMMON-LISP|::|TYPE|
+ (|COMMON-LISP|::|OR| |COMMON-LISP|::|SYMBOL| |COMMON-LISP|::|NUMBER|
+ |COMMON-LISP|::|CHARACTER|)
+ |COMMON-LISP|::|SUBTYPEP| |COMMON-LISP|::|DEFCONSTANT|
+ |COMMON-LISP|::|DEFVAR| |COMMON-LISP|::|THE|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ "Define a typed constant." 1)
+ (|PORT|::|NAME| |COMMON-LISP|::|TYPE| |PORT|::|INIT| |PORT|::|DOC|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|106 108 (DEFCONST +EOF+ CONS ...)-10-1|
+ #16Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 3E 19 01)
+ ((|COMMON-LISP|::|TYPE| |COMMON-LISP|::|CONS| |PORT|::|+EOF+|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|106 108 (DEFCONST +EOF+ CONS ...)-10-2|
+ #32Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 DB 8C 57 06 DB DB 7B 01 31 5A DB
+ DC DD 2D 03 04 C6 19 01)
+ ((|COMMON-LISP|::|SPECIAL| |PORT|::|+EOF+|) |PORT|::|+EOF+|
+ |COMMON-LISP|::|VARIABLE|
+ "*The end-of-file object.\n
+To be passed as the third arg to `read' and checked against using `eq'."
+ |SYSTEM|::|%SET-DOCUMENTATION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|110 129 (DEFUN STRING-TOKENS (STRING &KEY # ...) ...)-11|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|STRING-TOKENS| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|STRING-TOKENS|
+ #136Y(03 00 01 00 01 00 00 00 A6 1C 04 00 00 00 3B 04 02 C9 FC 3D 03 3D
+ 02 3B 01 03 DF 31 D9 10 06 92 05 0C B4 B4 B4 72 8D 53 80 52 01 02
+ 1B 3C B3 01 02 DE 1B 05 AE 84 01 85 00 B5 AD 90 01 2F 1E 93 0A 06
+ AF B7 90 01 34 15 B8 63 6B 07 38 01 B3 BB 31 89 42 02 6A 04 6A 02
+ 14 0E 07 23 57 AD 72 64 B0 40 02 16 04 1B 1E AD 84 00 B0 63 B2 38
+ 01 80 7F 01 14 A2 23 71 AC 31 B1 16 02 54 67 00 00 00 2F 08 55 16
+ 01 11 19 06)
+ (:|START| :|END| :|MAX| :|PACKAGE| 0. :|KEYWORD|
+ |COMMON-LISP|::|*PACKAGE*| |PORT|::|+EOF+| |COMMON-LISP|::|CLOSE|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|STRING| |COMMON-LISP|::|&KEY| (|PORT|::|START| 0.)
+ |PORT|::|END| |COMMON-LISP|::|MAX|
+ ((:|PACKAGE| |COMMON-LISP|::|*PACKAGE*|)
+ (|COMMON-LISP|::|FIND-PACKAGE| :|KEYWORD|)))
+ "Read from STRING repeatedly, starting with START, up to MAX tokens.\n
+Return the list of objects read and the final index in STRING.\n
+Binds `*package*' to the KEYWORD package (or argument),\n
+so that the bare symbols are read as keywords."
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|133 144 (DEFMACRO COMPOSE (&REST FUNCTIONS) ...)-12|
+ #23Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC DD 72 4C 32 9C C5 19 01)
+ (|PORT|::|COMPOSE| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|COMPOSE|
+ #27Y(00 00 00 00 02 00 00 00 26 03 95 02 DA 72 AA DB AD 7B 01 AF AF C7
+ 74 61 03 19 05)
+ ("COMPOSE-ARG-" |COMMON-LISP|::|LAMBDA|
+ #Y(|PORT|::|COMPOSE-REC|
+ #54Y(00 00 00 00 02 00 00 00 26 03 94 02 A0 5C 1C 13 9F 14 7B 02 A0
+ 5B 20 1B DA A1 5B 78 24 01 0B 9E 5D 19 04 95 03 AF 28 62 1B 67
+ A1 5B 5C 78 9F 5C 5D 1B 6D 15 19 03)
+ (|COMMON-LISP|::|FUNCALL| |COMMON-LISP|::|QUOTE|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|XX| |PORT|::|YY|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ "Macro: compose functions or macros of 1 argument into a lambda.\n
+E.g., (compose abs (dl-val zz) 'key) ==>\n
+ (lambda (yy) (abs (funcall (dl-val zz) (funcall key yy))))"
+ 1)
+ (|COMMON-LISP|::|&REST| |PORT|::|FUNCTIONS|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|149 154 (DECLAIM (FTYPE # IPADDR-TO-DOTTED))-13|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 19 01)
+ ((|COMMON-LISP|::|FTYPE|
+ (|COMMON-LISP|::|FUNCTION| ((|COMMON-LISP|::|UNSIGNED-BYTE| 32.))
+ (|COMMON-LISP|::|VALUES| |COMMON-LISP|::|SIMPLE-STRING|))
+ |PORT|::|IPADDR-TO-DOTTED|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|155 164 (DEFUN IPADDR-TO-DOTTED (IPADDR) ...)-14|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|IPADDR-TO-DOTTED| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|IPADDR-TO-DOTTED|
+ #90Y(00 00 00 00 01 00 00 00 26 02 38 02 72 8F DA AF DB 72 EC 73 02 40
+ DA B0 DC 72 EC 73 02 40 DA B1 DD 72 EC 73 02 40 DA B2 73 02 40 B0
+ 01 06 B6 2D 08 04 DF B1 31 94 B0 01 06 B5 2D 08 04 DF B1 31 94 B0
+ 01 06 B4 2D 08 04 DF B1 31 94 B0 01 06 B3 2D 08 04 16 04 AC 32 90
+ 19 03)
+ (255. -24. -16. -8. |SYSTEM|::|DO-FORMAT-DECIMAL| #\.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|IPADDR|) "Number --> string." 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|166 167 (DECLAIM (FTYPE # DOTTED-TO-IPADDR))-15|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 31 62 19 01)
+ ((|COMMON-LISP|::|FTYPE|
+ (|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|STRING|)
+ (|COMMON-LISP|::|VALUES| (|COMMON-LISP|::|UNSIGNED-BYTE| 32.)))
+ |PORT|::|DOTTED-TO-IPADDR|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|168 177 (DEFUN DOTTED-TO-IPADDR (DOTTED) ...)-16|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|DOTTED-TO-IPADDR| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|DOTTED-TO-IPADDR|
+ #47Y(00 00 00 00 01 00 00 00 26 02 DA DB AF 38 07 72 71 6F 02 94 00 DD
+ 72 EC 9E 5C 78 DE 72 EC 9F 5C 5C 78 DF 72 EC A0 5C 5C 5C 78 33 04
+ 37 19 03)
+ (#\Space #\. |PORT|::|STRING-TOKENS| 24. 16. 8.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|DOTTED|) "String --> number." 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|179 204 (DEFSTRUCT HOSTENT "see gethostbyname(3) for details" ...)-17|
+ #628Y(00 00 00 00 00 00 00 00 20 01 00 2B 01 DA DB DC 38 01 72 9E 2F 03 5D
+ 0B 00 00 DA 2F 04 DA DF 32 A3 DA 68 01 00 E0 63 E1 E2 6B 09 E4 E5 E6
+ E7 E8 E9 EA EB EC ED ED 6F 14 70 15 F0 F1 F2 F3 F4 63 6E 11 1B 6B 09
+ E4 F6 E6 F7 E8 65 1E EA EB EC 01 02 6F 14 70 15 F0 65 1F F2 65 20 F4
+ 63 6E 11 1B 6B 09 E4 65 21 E6 65 22 E8 65 1E EA EB EC 01 02 6F 14 70
+ 15 F0 65 23 F2 65 24 F4 63 6E 11 1B 6B 09 E4 65 25 E6 65 26 E8 65 27
+ EA EB EC 65 20 65 20 6F 14 70 15 F0 65 28 F2 65 29 F4 63 6E 11 1B 7B
+ 04 6B 2A E4 E5 E6 E7 E8 E9 EA EB EC ED ED 6F 14 70 15 F0 65 2B 65 2C
+ 65 2D 65 2E 65 2F 6E 11 30 6B 2A E4 F6 E6 F7 E8 65 1E EA EB EC 01 02
+ 6F 14 70 15 F0 65 31 65 2C 65 32 65 2E 65 33 6E 11 30 6B 2A E4 65 21
+ E6 65 22 E8 65 1E EA EB EC 01 02 6F 14 70 15 F0 65 34 65 2C 65 35 65
+ 2E 65 36 6E 11 30 6B 2A E4 65 25 E6 65 26 E8 65 27 EA EB EC 65 20 65
+ 20 6F 14 70 15 F0 65 37 65 2C 65 38 65 2E 65 39 6E 11 30 7B 04 2D 08
+ 3A E0 2F 3B E0 AD 6D 3C 01 32 9C 16 01 65 3D 31 62 E2 2F 3B E2 65 3E
+ 65 3F 32 A2 E2 65 40 32 9C 65 41 31 62 E1 2F 3B E1 65 3E 65 42 32 A2
+ E1 65 43 32 9C 65 44 31 62 65 45 31 62 65 46 2F 3B 65 46 65 3E 65 47
+ 32 A2 65 46 65 48 32 9C 65 46 65 49 DA 32 A2 65 4A 31 62 65 4B 31 62
+ 65 4C 2F 3B 65 4C 65 3E 65 4D 32 A2 65 4C 65 4E 32 9C 65 4C 65 49 DA
+ 32 A2 65 4F 31 62 65 50 31 62 65 51 2F 3B 65 51 65 3E 65 52 32 A2 65
+ 51 65 53 32 9C 65 51 65 49 DA 32 A2 65 54 31 62 65 55 31 62 65 56 2F
+ 3B 65 56 65 3E 65 57 32 A2 65 56 65 58 32 9C 65 56 65 49 DA 32 A2 65
+ 59 31 62 65 5A 31 62 65 5B 2F 3B 65 5B 65 3E 65 5C 32 A2 65 5B 65 5D
+ 32 9C 65 46 65 5E DA 32 A2 65 5F 31 62 65 60 31 62 65 61 2F 3B 65 61
+ 65 3E 65 62 32 A2 65 61 65 63 32 9C 65 4C 65 5E DA 32 A2 65 64 31 62
+ 65 65 31 62 65 66 2F 3B 65 66 65 3E 65 67 32 A2 65 66 65 68 32 9C 65
+ 51 65 5E DA 32 A2 65 69 31 62 65 6A 31 62 65 6B 2F 3B 65 6B 65 3E 65
+ 6C 32 A2 65 6B 65 6D 32 9C 65 56 65 5E DA 32 A2 DA 65 6E 65 6F 2D 03
+ 70 DA 2F 71 C5 19 01)
+ (|PORT|::|HOSTENT| |COMMON-LISP|::|STRUCTURE-OBJECT| |CLOS|::|CLOSCLASS|
+ |CLOS|::|CLASS-NAMES| |SYSTEM|::|STRUCTURE-UNDEFINE-ACCESSORIES|
+ |SYSTEM|::|DEFSTRUCT-DESCRIPTION| |PORT|::|MAKE-HOSTENT|
+ |PORT|::|COPY-HOSTENT| |PORT|::|HOSTENT-P|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME| |PORT|::|NAME|
+ :|INITARGS| (:|NAME|) :|TYPE| |COMMON-LISP|::|SIMPLE-STRING| :|ALLOCATION|
+ :|INSTANCE| |CLOS|::|INHERITABLE-INITER| #1=""
+ |SYSTEM|::|MAKE-CONSTANT-INITFUNCTION|
+ |CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| |CLOS|::|INHERITABLE-DOC|
+ (|COMMON-LISP|::|NIL|) |CLOS|::|LOCATION| 1. |CLOS|::|READONLY|
+ |CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |PORT|::|ALIASES| (:|ALIASES|) |COMMON-LISP|::|LIST| (|COMMON-LISP|::|NIL|)
+ 2. |PORT|::|ADDR-LIST| (:|ADDR-LIST|) (|COMMON-LISP|::|NIL|) 3.
+ |PORT|::|ADDR-TYPE| (:|ADDR-TYPE|) |COMMON-LISP|::|FIXNUM|
+ (|COMMON-LISP|::|NIL|) 4. |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ (|COMMON-LISP|::|NIL|) :|READERS| (|PORT|::|HOSTENT-NAME|) :|WRITERS|
+ ((|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-NAME|))
+ |CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ (|COMMON-LISP|::|NIL|) (|PORT|::|HOSTENT-ALIASES|)
+ ((|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ALIASES|)) (|COMMON-LISP|::|NIL|)
+ (|PORT|::|HOSTENT-ADDR-LIST|)
+ ((|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-LIST|))
+ (|COMMON-LISP|::|NIL|) (|PORT|::|HOSTENT-ADDR-TYPE|)
+ ((|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-TYPE|))
+ |CLOS|::|DEFINE-STRUCTURE-CLASS| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|MAKE-HOSTENT|
+ #61Y(00 00 00 00 00 00 00 00 A6 1B 04 00 01 00 3B 04 02 CA FC 3D 03 3D
+ 02 3B 01 02 CB F9 69 00 01 E1 72 45 E2 AD E3 B4 32 44 E2 AD E0 B3
+ 32 44 E2 AD E4 B2 32 44 E2 AD E5 B1 32 44 15 19 05)
+ (|COMMON-LISP|::|NIL| :|NAME| :|ALIASES| :|ADDR-LIST| :|ADDR-TYPE| #1#
+ 2. 5. |PORT|::|HOSTENT| 1. 3. 4.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|&KEY| (#:|NAME| #1#) (#:|ALIASES| |COMMON-LISP|::|NIL|)
+ (#:|ADDR-LIST| |COMMON-LISP|::|NIL|) (#:|ADDR-TYPE| 2.))
+ |COMMON-LISP|::|NIL| 1)
+ (|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-P|) |SYSTEM|::|INLINE-EXPANSION|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|HOSTENT-P|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-P|
+ (|SYSTEM|::|%STRUCTURE-TYPE-P| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT|)))
+ #Y(|PORT|::|HOSTENT-P|
+ #16Y(00 00 00 00 01 00 00 00 20 02 DA AE 32 47 19 02)
+ (|PORT|::|HOSTENT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|INLINE| |PORT|::|COPY-HOSTENT|)
+ ((|COMMON-LISP|::|STRUCTURE|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|COPY-HOSTENT|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|COPY-HOSTENT|
+ (|COMMON-LISP|::|COPY-STRUCTURE| |COMMON-LISP|::|STRUCTURE|)))
+ #Y(|PORT|::|COPY-HOSTENT|
+ #15Y(00 00 00 00 01 00 00 00 26 02 AD 32 46 19 02) ()
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|STRUCTURE|) |COMMON-LISP|::|NIL| 1)
+ (|COMMON-LISP|::|FUNCTION| |PORT|::|HOSTENT-NAME| (|PORT|::|HOSTENT|)
+ |COMMON-LISP|::|SIMPLE-STRING|)
+ (|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-NAME|) |PORT|::|HOSTENT-NAME|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|HOSTENT-NAME|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-NAME|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 1.))))
+ #Y(|PORT|::|HOSTENT-NAME|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|PORT|::|HOSTENT| 1.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ |SYSTEM|::|DEFSTRUCT-READER|
+ (|COMMON-LISP|::|FUNCTION| |PORT|::|HOSTENT-ALIASES| (|PORT|::|HOSTENT|)
+ |COMMON-LISP|::|LIST|)
+ (|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-ALIASES|)
+ |PORT|::|HOSTENT-ALIASES|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| |PORT|::|HOSTENT-ALIASES|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-ALIASES|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 2.))))
+ #Y(|PORT|::|HOSTENT-ALIASES|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|PORT|::|HOSTENT| 2.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|FUNCTION| |PORT|::|HOSTENT-ADDR-LIST| (|PORT|::|HOSTENT|)
+ |COMMON-LISP|::|LIST|)
+ (|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-ADDR-LIST|)
+ |PORT|::|HOSTENT-ADDR-LIST|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| |PORT|::|HOSTENT-ADDR-LIST|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-ADDR-LIST|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 3.))))
+ #Y(|PORT|::|HOSTENT-ADDR-LIST|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|PORT|::|HOSTENT| 3.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|FUNCTION| |PORT|::|HOSTENT-ADDR-TYPE| (|PORT|::|HOSTENT|)
+ |COMMON-LISP|::|FIXNUM|)
+ (|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-ADDR-TYPE|)
+ |PORT|::|HOSTENT-ADDR-TYPE|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| |PORT|::|HOSTENT-ADDR-TYPE|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-ADDR-TYPE|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 4.))))
+ #Y(|PORT|::|HOSTENT-ADDR-TYPE|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|PORT|::|HOSTENT| 4.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-NAME|)
+ (|COMMON-LISP|::|SIMPLE-STRING| |PORT|::|HOSTENT|)
+ |COMMON-LISP|::|SIMPLE-STRING|)
+ (|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-NAME|))
+ #.(|SYSTEM|::|GET-SETF-SYMBOL| '|PORT|::|HOSTENT-NAME|)
+ ((|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| #2=(|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-NAME|)))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-NAME|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 1.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING| .
+ #3=(|SYSTEM|::|VALUE|)))))
+ #Y(#2# #18Y(00 00 00 00 02 00 00 00 20 03 DA AE DB B1 32 44 19 03)
+ (|PORT|::|HOSTENT| 1.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |SYSTEM|::|DEFSTRUCT-WRITER|
+ (|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ALIASES|)
+ (|COMMON-LISP|::|LIST| |PORT|::|HOSTENT|) |COMMON-LISP|::|LIST|)
+ (|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ALIASES|))
+ #.(|SYSTEM|::|GET-SETF-SYMBOL| '|PORT|::|HOSTENT-ALIASES|)
+ ((|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN|
+ #4=(|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ALIASES|)))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-ALIASES|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 2.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST| . #3#))))
+ #Y(#4# #18Y(00 00 00 00 02 00 00 00 20 03 DA AE DB B1 32 44 19 03)
+ (|PORT|::|HOSTENT| 2.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ (|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-LIST|)
+ (|COMMON-LISP|::|LIST| |PORT|::|HOSTENT|) |COMMON-LISP|::|LIST|)
+ (|COMMON-LISP|::|INLINE|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-LIST|))
+ #.(|SYSTEM|::|GET-SETF-SYMBOL| '|PORT|::|HOSTENT-ADDR-LIST|)
+ ((|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN|
+ #5=(|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-LIST|)))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-ADDR-LIST|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 3.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST| . #3#))))
+ #Y(#5# #18Y(00 00 00 00 02 00 00 00 20 03 DA AE DB B1 32 44 19 03)
+ (|PORT|::|HOSTENT| 3.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ (|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-TYPE|)
+ (|COMMON-LISP|::|FIXNUM| |PORT|::|HOSTENT|) |COMMON-LISP|::|FIXNUM|)
+ (|COMMON-LISP|::|INLINE|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-TYPE|))
+ #.(|SYSTEM|::|GET-SETF-SYMBOL| '|PORT|::|HOSTENT-ADDR-TYPE|)
+ ((|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN|
+ #6=(|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-TYPE|)))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-ADDR-TYPE|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 4.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM| . #3#))))
+ #Y(#6# #18Y(00 00 00 00 02 00 00 00 20 03 DA AE DB B1 32 44 19 03)
+ (|PORT|::|HOSTENT| 4.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|TYPE| "see gethostbyname(3) for details"
+ |SYSTEM|::|%SET-DOCUMENTATION|
+ |CLOS|::|DEFSTRUCT-REMOVE-PRINT-OBJECT-METHOD|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|204 291 (DEFUN RESOLVE-HOST-IPADDR (HOST) ...)-18|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|RESOLVE-HOST-IPADDR| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|RESOLVE-HOST-IPADDR|
+ #42Y(00 00 00 00 01 00 00 00 26 02 AD 6F 00 DB DC AE DD 72 43 DE DC B0
+ DF 72 43 E0 DC B2 E1 72 43 E2 DC B4 E3 72 43 2D 08 0A 19 03)
+ (|POSIX|::|RESOLVE-HOST-IPADDR| :|NAME| |POSIX|::|HOSTENT| 1. :|ALIASES|
+ 2. :|ADDR-LIST| 3. :|ADDR-TYPE| 4. |PORT|::|MAKE-HOSTENT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|HOST|) "Call gethostbyname(3) or gethostbyaddr(3)." 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|293 306 (DEFUN IPADDR-CLOSURE (ADDRESS) ...)-19|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|IPADDR-CLOSURE| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|IPADDR-CLOSURE|
+ #58Y(00 00 00 00 01 00 00 00 26 02 00 2B 02 38 09 C5 FB 31 6D 0B 00 00
+ 38 09 C5 FB 31 6D 0B 00 01 9D 2B 01 AC 2C 01 01 0B 00 00 AF 06 01
+ 00 34 16 01 68 00 01 68 01 00 40 02 19 03)
+ (|COMMON-LISP|::|EQUALP|
+ #Y(|PORT|::|IPADDR-CLOSURE-HANDLE|
+ #84Y(00 00 00 00 01 00 00 00 26 02 AD 69 01 01 38 01 8C 6E 3E AD 6F
+ 01 69 01 01 AF AD AF 31 6F 16 01 69 01 02 AD AD 38 01 71 6E AE
+ AE B2 A0 7A 31 6F 16 02 DC AD DD 72 43 28 51 69 00 01 DC AE DE
+ 72 43 33 00 18 69 00 01 DC AE DF 72 43 33 00 18 19 03 00 19 02)
+ (|COMMON-LISP|::|NIL| |PORT|::|RESOLVE-HOST-IPADDR|
+ |PORT|::|HOSTENT| 1. 2. 3.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|S|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|ADDRESS|)
+ "Resolve all addresses and names associated with the argument." 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|308 323 (DEFTYPE SOCKET NIL ...)-20|
+ #24Y(00 00 00 00 00 00 00 00 20 01 DA DB DC 32 A2 DA DD 63 2D 03 04 C5 19
+ 01)
+ (|PORT|::|SOCKET| |SYSTEM|::|DEFTYPE-EXPANDER|
+ #Y(#:|DEFTYPE-SOCKET|
+ #26Y(00 00 00 00 01 00 00 00 20 02 AD DA DA 2D 03 01 1D 03 C8 19 02 AD
+ 2F 02 19 02)
+ (1. |SYSTEM|::|PROPER-LIST-LENGTH-IN-BOUNDS-P|
+ |SYSTEM|::|TYPE-CALL-ERROR| |COMMON-LISP|::|STREAM|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|TYPE| |SYSTEM|::|%SET-DOCUMENTATION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|325 376 (DEFUN OPEN-SOCKET (HOST PORT &OPTIONAL ...) ...)-21|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|OPEN-SOCKET| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|OPEN-SOCKET|
+ #61Y(00 00 00 00 02 00 01 00 26 09 3D 01 AF 8E 19 1B AF 8E 1E 1A AF DD
+ DE 70 05 E0 2D 03 07 14 AF AD E2 92 05 16 CF 14 2D 04 0B 19 05 A0
+ 1B 6F AF 6F 00 DB AD DC 32 43 16 01 1B 63 CE 1B 68)
+ (|PORT|::|RESOLVE-HOST-IPADDR| |PORT|::|HOSTENT| 1. |PORT|::|HOST|
+ (|COMMON-LISP|::|STRING| |COMMON-LISP|::|INTEGER|)
+ |SYSTEM|::|TYPECASE-ERROR-STRING|
+ (|COMMON-LISP|::|OR| |COMMON-LISP|::|STRING| |COMMON-LISP|::|INTEGER|)
+ |SYSTEM|::|ETYPECASE-FAILED| :|ELEMENT-TYPE|
+ (|COMMON-LISP|::|UNSIGNED-BYTE| 8.) |COMMON-LISP|::|CHARACTER|
+ |SOCKET|::|SOCKET-CONNECT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|HOST| |PORT|::|PORT| |COMMON-LISP|::|&OPTIONAL| |PORT|::|BIN|)
+ "Open a socket connection to HOST at PORT." 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|378 384 (DEFUN SET-SOCKET-STREAM-FORMAT (SOCKET FORMAT) ...)-22|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|SET-SOCKET-STREAM-FORMAT| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|SET-SOCKET-STREAM-FORMAT|
+ #16Y(00 00 00 00 02 00 00 00 26 03 AD AF 30 00 19 03)
+ (#.(|SYSTEM|::|GET-SETF-SYMBOL| '|COMMON-LISP|::|STREAM-ELEMENT-TYPE|))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|SOCKET| |COMMON-LISP|::|FORMAT|)
+ "switch between binary and text output" 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|386 456 (DEFUN SOCKET-HOST/PORT (SOCK) ...)-23|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|SOCKET-HOST/PORT| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|SOCKET-HOST/PORT|
+ #32Y(00 00 00 00 01 00 00 00 26 02 AD 2F 00 42 02 AF 2F 01 42 02 AF C7
+ 74 AF AF C7 74 AF 40 04 19 06)
+ (|SOCKET|::|SOCKET-STREAM-PEER| |SOCKET|::|SOCKET-STREAM-LOCAL|
+ #Y(|PORT|::|SOCKET-HOST/PORT-IP|
+ #24Y(00 00 00 00 01 00 00 00 26 02 AD DA DB B0 38 06 C7 F9 72 7A 32
+ 60 19 02)
+ (0. #\Space #.#'|COMMON-LISP|::|CHAR=|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|HO|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|SOCK|) "Return the remote and local host&port, as 4 values."
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|458 464 (DEFUN SOCKET-STRING (SOCK) ...)-24|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|SOCKET-STRING| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|SOCKET-STRING|
+ #66Y(03 00 01 00 01 00 00 00 26 02 00 2B 01 7F 02 00 00 9D 2B 01 DA 38
+ 01 32 8F 0B 00 00 53 17 AE 6D 01 01 68 04 00 68 04 00 DC 64 DD 64
+ 2D 07 04 68 02 00 32 90 54 08 00 00 00 00 14 38 01 32 97 55 19 04)
+ (|COMMON-LISP|::|CHARACTER|
+ #Y(|PORT|::|SOCKET-STRING-1|
+ #30Y(00 00 00 00 00 00 00 00 26 01 69 01 01 2F 01 42 04 69 00 01 DC
+ AF AF B3 B3 2D 06 03 19 05)
+ (|COMMON-LISP|::|NIL| |PORT|::|SOCKET-HOST/PORT|
+ #Y(|PORT|::|SOCKET-STRING-1-1|
+ #68Y(00 00 00 00 05 00 00 00 21 00 DA B3 38 02 31 95 B1 B3 31 90
+ DB B3 31 94 B2 01 06 B7 2D 08 02 DD B3 38 02 31 95 B2 2F 04
+ 10 05 B2 B6 31 8D 11 B2 2F 06 DB B3 31 94 B2 01 06 B5 2D 08
+ 02 E1 B3 31 94 9E 19 07)
+ ("[local: " #\: |SYSTEM|::|DO-FORMAT-DECIMAL| "] [peer: "
+ |SYSTEM|::|STREAM-START-S-EXPRESSION|
+ |COMMON-LISP|::|*PRINT-RIGHT-MARGIN*|
+ |SYSTEM|::|STREAM-END-S-EXPRESSION| #\])
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|FORMAT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|) ()
+ |COMMON-LISP|::|NIL| 1)
+ :|TYPE| :|IDENTITY| |SYSTEM|::|WRITE-UNREADABLE|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|SOCK|) "Print the socket local&peer host&port to a string." 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|466 484 (DEFTYPE SOCKET-SERVER NIL ...)-25|
+ #24Y(00 00 00 00 00 00 00 00 20 01 DA DB DC 32 A2 DA DD 63 2D 03 04 C5 19
+ 01)
+ (|PORT|::|SOCKET-SERVER| |SYSTEM|::|DEFTYPE-EXPANDER|
+ #Y(#:|DEFTYPE-SOCKET-SERVER|
+ #26Y(00 00 00 00 01 00 00 00 20 02 AD DA DA 2D 03 01 1D 03 C8 19 02 AD
+ 2F 02 19 02)
+ (1. |SYSTEM|::|PROPER-LIST-LENGTH-IN-BOUNDS-P|
+ |SYSTEM|::|TYPE-CALL-ERROR| |SOCKET|::|SOCKET-SERVER|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|TYPE| |SYSTEM|::|%SET-DOCUMENTATION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|486 522 (DEFUN OPEN-SOCKET-SERVER (&OPTIONAL PORT) ...)-26|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|OPEN-SOCKET-SERVER| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|OPEN-SOCKET-SERVER|
+ #17Y(00 00 00 00 00 00 01 00 26 07 3D 01 AD 2F 00 19 02)
+ (|SOCKET|::|SOCKET-SERVER|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|&OPTIONAL| |PORT|::|PORT|)
+ "Open a `generic' socket server." 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|524 601 (DEFUN SOCKET-ACCEPT (SERV &KEY BIN ...) ...)-27|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|SOCKET-ACCEPT| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|SOCKET-ACCEPT|
+ #69Y(00 00 00 00 01 00 00 00 A6 1C 02 00 00 00 3D 02 3B 01 0A 7D 01 93
+ 01 08 1B 07 CB 1B 20 92 01 01 C7 14 38 01 32 CE 42 02 B1 93 04 01
+ 9F 14 AE DD 72 D1 2D 03 04 1F 0C B1 DF 92 06 5E CC 14 2D 03 08 19
+ 06 19 06)
+ (:|BIN| :|WAIT| 0. 1.0d-6 |SOCKET|::|SOCKET-WAIT| :|ELEMENT-TYPE|
+ (|COMMON-LISP|::|UNSIGNED-BYTE| 8.) |COMMON-LISP|::|CHARACTER|
+ |SOCKET|::|SOCKET-ACCEPT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|SERV| |COMMON-LISP|::|&KEY| |PORT|::|BIN| |PORT|::|WAIT|)
+ "Accept a connection on a socket server (passive socket).\n
+Keyword arguments are:\n
+ BIN - create a binary stream;\n
+ WAIT - wait for the connection this many seconds\n
+ (the default is NIL - wait forever).\n
+Returns a socket stream or NIL."
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|603 619 (DEFUN SOCKET-SERVER-CLOSE (SERVER) ...)-28|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|SOCKET-SERVER-CLOSE| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|SOCKET-SERVER-CLOSE|
+ #15Y(00 00 00 00 01 00 00 00 26 02 AD 2F 00 19 02)
+ (|SOCKET|::|SOCKET-SERVER-CLOSE|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|SERVER|) "Close the server." 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|621 652 (DEFUN SOCKET-SERVER-HOST/PORT (SERVER) ...)-29|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|SOCKET-SERVER-HOST/PORT| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|SOCKET-SERVER-HOST/PORT|
+ #20Y(00 00 00 00 01 00 00 00 26 02 AD 6F 00 AE 6F 01 40 02 19 02)
+ (|SOCKET|::|SOCKET-SERVER-HOST| |SOCKET|::|SOCKET-SERVER-PORT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|SERVER|)
+ "Return the local host&port on which the server is running, as 2 values."
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|654 678 (DEFUN WAIT-FOR-STREAM (STREAM &OPTIONAL TIMEOUT) ...)-30|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|WAIT-FOR-STREAM| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|WAIT-FOR-STREAM|
+ #46Y(00 00 00 00 01 00 01 00 26 08 3B 01 07 7D 01 93 01 05 1B 04 92 01
+ 01 C5 14 38 01 32 CE 42 02 B0 93 04 01 9F 14 AE DB 72 D1 2D 03 02
+ 19 05)
+ (0. 1.0d-6 |SOCKET|::|SOCKET-STATUS|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|STREAM| |COMMON-LISP|::|&OPTIONAL| |PORT|::|TIMEOUT|)
+ "Sleep until there is input on the STREAM, or for TIMEOUT seconds,\n
+whichever comes first. If there was a timeout, return NIL."
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|680 702 (DEFUN OPEN-UNIX-SOCKET (PATH &KEY # ...) ...)-31|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|OPEN-UNIX-SOCKET| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|OPEN-UNIX-SOCKET|
+ #32Y(00 00 00 00 01 00 00 00 A6 1C 02 00 00 00 3D 01 AF DC 38 05 92 08
+ 06 C9 FC 32 0B 19 04 C8 1B 78)
+ (:|KIND| :|BIN| :|IO| (|COMMON-LISP|::|UNSIGNED-BYTE| 8.)
+ |COMMON-LISP|::|CHARACTER|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|PATH| |COMMON-LISP|::|&KEY| (|PORT|::|KIND| :|STREAM|)
+ |PORT|::|BIN|)
+ "Opens a unix socket. Path is the location.\n
+Kind can be :stream or :datagram."
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|704 711 (DEFUN REPORT-NETWORK-CONDITION (CC OUT) ...)-32|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|REPORT-NETWORK-CONDITION| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|REPORT-NETWORK-CONDITION|
+ #32Y(00 00 00 00 02 00 00 00 26 03 AD DA B0 6F 01 B1 6F 02 B2 6F 03 B3
+ 6F 04 B4 6F 05 2D 07 06 19 03)
+ (#Y(|PORT|::|REPORT-NETWORK-CONDITION-1|
+ #84Y(00 00 00 00 04 00 00 00 21 1A DA B2 31 94 B1 2F 01 10 02 B3 B5
+ 31 8D 11 B1 2F 03 DE B2 38 02 31 95 B1 2F 01 10 02 B2 B5 31 8D
+ 11 B1 2F 03 DF B2 31 94 B1 01 06 B5 2D 08 06 9E 5B 1C 05 83 01
+ 9E 19 06 E1 B2 31 94 B1 94 02 83 03 94 03 83 04 2D 03 08 1B 6B)
+ (#\[ |SYSTEM|::|STREAM-START-S-EXPRESSION|
+ |COMMON-LISP|::|*PRINT-RIGHT-MARGIN*|
+ |SYSTEM|::|STREAM-END-S-EXPRESSION| "] " #\:
+ |SYSTEM|::|DO-FORMAT-DECIMAL| #\Space
+ |SYSTEM|::|DO-FORMAT-INDIRECTION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |PORT|::|NET-PROC| |PORT|::|NET-HOST| |PORT|::|NET-PORT|
+ |PORT|::|NET-MESG| |PORT|::|NET-ARGS| |COMMON-LISP|::|FORMAT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|PORT|::|CC| |PORT|::|OUT|) |COMMON-LISP|::|NIL| 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|713 720 (DEFINE-CONDITION NETWORK (ERROR) ...)-33-1|
+ #138Y(00 00 00 00 00 00 00 00 20 01 6B 00 99 01 DC DD DE 7B 01 DF E0 E1 E2
+ E3 E4 E5 E6 63 E7 63 6F 0E E9 EA 7B 0C E0 EB E2 EC E4 ED E6 EE E7 EE
+ 6F 0E E9 EF 7B 0C E0 F0 E2 F1 E4 F2 E6 F3 E7 F3 6F 0E E9 F4 7B 0C E0
+ F5 E2 F6 E4 F7 E6 63 E7 63 6F 0E E9 65 1E 7B 0C E0 65 1F E2 65 20 E4
+ 65 21 E6 63 E7 63 6F 0E E9 65 22 7B 0C 7B 05 65 23 B3 65 24 65 25 63
+ 65 26 63 65 27 64 7B 06 33 02 23 37 07 16 01 DC 38 02 32 3A 3E 19 01)
+ (|CLOS|::|<STANDARD-CLASS>| |CLOS|::|ENSURE-CLASS| |PORT|::|NETWORK|
+ :|DIRECT-SUPERCLASSES| |COMMON-LISP|::|ERROR| :|DIRECT-SLOTS| :|NAME|
+ |PORT|::|PROC| :|READERS| (|PORT|::|NET-PROC|) :|INITARGS| (:|PROC|)
+ :|INITFORM| :|INITFUNCTION| |SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| :|TYPE|
+ |COMMON-LISP|::|SYMBOL| |PORT|::|HOST| (|PORT|::|NET-HOST|) (:|HOST|) ""
+ |COMMON-LISP|::|SIMPLE-STRING| |PORT|::|PORT| (|PORT|::|NET-PORT|)
+ (:|PORT|) 0. (|COMMON-LISP|::|UNSIGNED-BYTE| 16.) |PORT|::|MESG|
+ (|PORT|::|NET-MESG|) (:|MESG|)
+ (|COMMON-LISP|::|OR| |COMMON-LISP|::|NULL| |COMMON-LISP|::|SIMPLE-STRING|)
+ |PORT|::|ARGS| (|PORT|::|NET-ARGS|) (:|ARGS|) |COMMON-LISP|::|LIST|
+ :|METACLASS| (:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|)
+ :|DIRECT-DEFAULT-INITARGS| :|DOCUMENTATION| :|GENERIC-ACCESSORS|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|713 720 (DEFINE-CONDITION NETWORK (ERROR) ...)-33-2|
+ #49Y(00 00 00 00 00 00 00 00 20 01 DA DB 38 01 8F 9E 03 DA 2F 02 DA DD DE 63
+ DF E0 E1 E2 E3 E4 38 02 72 3A 64 38 02 72 3A 7B 02 7B 08 2D 03 0B 3E 19
+ 01)
+ (|CLOS|::|PRINT-OBJECT| |SYSTEM|::|TRACED-DEFINITION| |SYSTEM|::|UNTRACE1|
+ #Y(#:|713 720 (DEFINE-CONDITION NETWORK (ERROR) ...)-33-2-1|
+ #25Y(00 00 00 00 01 00 00 00 20 02 00 2B 01 7F 02 00 00 AC 6D 00 01 C6
+ 5D 19 03)
+ (#Y(#:|713 720 (DEFINE-CONDITION NETWORK (ERROR) ...)-33-2-1-1|
+ #45Y(00 00 00 00 03 00 00 00 20 04 0E 01 1C 12 0E 02 1C 0E AE AE 30
+ 04 9F 19 04 14 AF AF 36 02 19 04 92 03 76 69 00 01 AF AF 2D 03
+ 03 19 04)
+ (|COMMON-LISP|::|NIL| |COMMON-LISP|::|*PRINT-ESCAPE*|
+ |COMMON-LISP|::|*PRINT-READABLY*| |CLOS|::|%NO-NEXT-METHOD|
+ |PORT|::|REPORT-NETWORK-CONDITION|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ (|COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ :|QUALIFIERS| :|LAMBDA-LIST|
+ (|COMMON-LISP|::|CONDITION| |COMMON-LISP|::|STREAM|) |CLOS|::|SIGNATURE|
+ #(2. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ :|SPECIALIZERS| |PORT|::|NETWORK| |CLOS|::|DO-DEFMETHOD|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|713 720 (DEFINE-CONDITION NETWORK (ERROR) ...)-33-3|
+ #13Y(00 00 00 00 00 00 00 00 20 01 C5 19 01) (|PORT|::|NETWORK|)
+ |COMMON-LISP|::|NIL|)
+#Y(#:|722 728 (DEFINE-CONDITION TIMEOUT (NETWORK) ...)-34-1|
+ #64Y(00 00 00 00 00 00 00 00 20 01 6B 00 99 01 DC DD DE 7B 01 DF E0 E1 E2 E3
+ E4 E5 E6 E7 E8 E7 6F 0F EA EB 7B 0C 7B 01 EC B3 ED EE 63 EF 63 F0 64 7B
+ 06 33 02 23 37 07 16 01 DC 38 02 32 3A 3E 19 01)
+ (|CLOS|::|<STANDARD-CLASS>| |CLOS|::|ENSURE-CLASS| |PORT|::|TIMEOUT|
+ :|DIRECT-SUPERCLASSES| |PORT|::|NETWORK| :|DIRECT-SLOTS| :|NAME|
+ |COMMON-LISP|::|TIME| :|READERS| (|PORT|::|TIMEOUT-TIME|) :|INITARGS|
+ (:|TIME|) :|INITFORM| 0. :|INITFUNCTION|
+ |SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| :|TYPE| (|COMMON-LISP|::|REAL| 0.)
+ :|METACLASS| (:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|)
+ :|DIRECT-DEFAULT-INITARGS| :|DOCUMENTATION| :|GENERIC-ACCESSORS|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|722 728 (DEFINE-CONDITION TIMEOUT (NETWORK) ...)-34-2|
+ #49Y(00 00 00 00 00 00 00 00 20 01 DA DB 38 01 8F 9E 03 DA 2F 02 DA DD DE 63
+ DF E0 E1 E2 E3 E4 38 02 72 3A 64 38 02 72 3A 7B 02 7B 08 2D 03 0B 3E 19
+ 01)
+ (|CLOS|::|PRINT-OBJECT| |SYSTEM|::|TRACED-DEFINITION| |SYSTEM|::|UNTRACE1|
+ #Y(#:|722 728 (DEFINE-CONDITION TIMEOUT (NETWORK) ...)-34-2-1|
+ #25Y(00 00 00 00 01 00 00 00 20 02 00 2B 01 7F 02 00 00 AC 6D 00 01 C6
+ 5D 19 03)
+ (#Y(#:|722 728 (DEFINE-CONDITION TIMEOUT (NETWORK) ...)-34-2-1-1|
+ #59Y(00 00 00 00 03 00 00 00 20 04 0E 01 1C 20 0E 02 1C 1C AE AE 30
+ 04 AE 6F 05 8F AD 08 AD E0 B0 6F 05 2D 03 07 9F 19 04 14 AF AF
+ 36 02 19 04 92 03 76 69 00 01 AF AF 2D 03 03 19 04)
+ (|COMMON-LISP|::|NIL| |COMMON-LISP|::|*PRINT-ESCAPE*|
+ |COMMON-LISP|::|*PRINT-READABLY*| |CLOS|::|%NO-NEXT-METHOD|
+ |PORT|::|REPORT-NETWORK-CONDITION| |PORT|::|TIMEOUT-TIME|
+ #Y(#:|722 728 (DEFINE-CONDITION TIMEOUT (NETWORK) ...)-34-2-1-1-1|
+ #29Y(00 00 00 00 02 00 00 00 21 18 DA B0 38 02 31 95 AE B0 31 90
+ DB B0 38 02 31 95 9E 19 04)
+ (" [timeout " " sec]")
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|FORMAT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ (|COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ :|QUALIFIERS| :|LAMBDA-LIST|
+ (|COMMON-LISP|::|CONDITION| |COMMON-LISP|::|STREAM|) |CLOS|::|SIGNATURE|
+ #(2. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ :|SPECIALIZERS| |PORT|::|TIMEOUT| |CLOS|::|DO-DEFMETHOD|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|722 728 (DEFINE-CONDITION TIMEOUT (NETWORK) ...)-34-3|
+ #13Y(00 00 00 00 00 00 00 00 20 01 C5 19 01) (|PORT|::|TIMEOUT|)
+ |COMMON-LISP|::|NIL|)
+#Y(#:|730 730 (DEFINE-CONDITION LOGIN (NETWORK) ...)-35-1|
+ #47Y(00 00 00 00 00 00 00 00 20 01 6B 00 99 01 DC DD DE 7B 01 DF 63 E0 B3 E1
+ E2 63 E3 63 E4 64 7B 06 33 02 23 37 07 16 01 DC 38 02 32 3A 3E 19 01)
+ (|CLOS|::|<STANDARD-CLASS>| |CLOS|::|ENSURE-CLASS| |PORT|::|LOGIN|
+ :|DIRECT-SUPERCLASSES| |PORT|::|NETWORK| :|DIRECT-SLOTS| :|METACLASS|
+ (:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|) :|DIRECT-DEFAULT-INITARGS|
+ :|DOCUMENTATION| :|GENERIC-ACCESSORS|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|730 730 (DEFINE-CONDITION LOGIN (NETWORK) ...)-35-2|
+ #13Y(00 00 00 00 00 00 00 00 20 01 C5 19 01) (|PORT|::|LOGIN|)
+ |COMMON-LISP|::|NIL|)
+#Y(#:|731 731 (DEFINE-CONDITION NET-PATH (NETWORK) ...)-36-1|
+ #47Y(00 00 00 00 00 00 00 00 20 01 6B 00 99 01 DC DD DE 7B 01 DF 63 E0 B3 E1
+ E2 63 E3 63 E4 64 7B 06 33 02 23 37 07 16 01 DC 38 02 32 3A 3E 19 01)
+ (|CLOS|::|<STANDARD-CLASS>| |CLOS|::|ENSURE-CLASS| |PORT|::|NET-PATH|
+ :|DIRECT-SUPERCLASSES| |PORT|::|NETWORK| :|DIRECT-SLOTS| :|METACLASS|
+ (:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|) :|DIRECT-DEFAULT-INITARGS|
+ :|DOCUMENTATION| :|GENERIC-ACCESSORS|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|731 731 (DEFINE-CONDITION NET-PATH (NETWORK) ...)-36-2|
+ #13Y(00 00 00 00 00 00 00 00 20 01 C5 19 01) (|PORT|::|NET-PATH|)
+ |COMMON-LISP|::|NIL|)
+#Y(#:|733 742 (DEFSTRUCT SERVENT "see getservbyname(3) for details" ...)-37|
+ #632Y(00 00 00 00 00 00 00 00 20 01 00 2B 01 DA DB DC 38 01 72 9E 2F 03 5D
+ 0B 00 00 DA 2F 04 DA DF 32 A3 DA 68 01 00 E0 63 E1 E2 6B 09 E4 E5 E6
+ E7 E8 E9 EA EB EC ED ED 6F 14 70 15 F0 F1 F2 F3 F4 63 6E 11 1B 6B 09
+ E4 F6 E6 F7 E8 65 1E EA EB EC 01 02 6F 14 70 15 F0 65 1F F2 65 20 F4
+ 63 6E 11 1B 6B 09 E4 65 21 E6 65 22 E8 65 23 EA EB EC 65 24 65 24 6F
+ 14 70 15 F0 65 25 F2 65 26 F4 63 6E 11 1B 6B 09 E4 65 27 E6 65 28 E8
+ 65 29 EA EB EC 65 2A 65 2A 6F 14 70 15 F0 65 2B F2 65 2C F4 63 6E 11
+ 1B 7B 04 6B 2D E4 E5 E6 E7 E8 E9 EA EB EC ED ED 6F 14 70 15 F0 65 2E
+ 65 2F 65 30 65 31 65 32 6E 11 33 6B 2D E4 F6 E6 F7 E8 65 1E EA EB EC
+ 01 02 6F 14 70 15 F0 65 34 65 2F 65 35 65 31 65 36 6E 11 33 6B 2D E4
+ 65 21 E6 65 22 E8 65 23 EA EB EC 65 24 65 24 6F 14 70 15 F0 65 37 65
+ 2F 65 38 65 31 65 39 6E 11 33 6B 2D E4 65 27 E6 65 28 E8 65 29 EA EB
+ EC 65 2A 65 2A 6F 14 70 15 F0 65 3A 65 2F 65 3B 65 31 65 3C 6E 11 33
+ 7B 04 2D 08 3D E0 2F 3E E0 AD 6D 3F 01 32 9C 16 01 65 40 31 62 E2 2F
+ 3E E2 65 41 65 42 32 A2 E2 65 43 32 9C 65 44 31 62 E1 2F 3E E1 65 41
+ 65 45 32 A2 E1 65 46 32 9C 65 47 31 62 65 48 31 62 65 49 2F 3E 65 49
+ 65 41 65 4A 32 A2 65 49 65 4B 32 9C 65 49 65 4C DA 32 A2 65 4D 31 62
+ 65 4E 31 62 65 4F 2F 3E 65 4F 65 41 65 50 32 A2 65 4F 65 51 32 9C 65
+ 4F 65 4C DA 32 A2 65 52 31 62 65 53 31 62 65 54 2F 3E 65 54 65 41 65
+ 55 32 A2 65 54 65 56 32 9C 65 54 65 4C DA 32 A2 65 57 31 62 65 58 31
+ 62 65 59 2F 3E 65 59 65 41 65 5A 32 A2 65 59 65 5B 32 9C 65 59 65 4C
+ DA 32 A2 65 5C 31 62 65 5D 31 62 65 5E 2F 3E 65 5E 65 41 65 5F 32 A2
+ 65 5E 65 60 32 9C 65 49 65 61 DA 32 A2 65 62 31 62 65 63 31 62 65 64
+ 2F 3E 65 64 65 41 65 65 32 A2 65 64 65 66 32 9C 65 4F 65 61 DA 32 A2
+ 65 67 31 62 65 68 31 62 65 69 2F 3E 65 69 65 41 65 6A 32 A2 65 69 65
+ 6B 32 9C 65 54 65 61 DA 32 A2 65 6C 31 62 65 6D 31 62 65 6E 2F 3E 65
+ 6E 65 41 65 6F 32 A2 65 6E 65 70 32 9C 65 59 65 61 DA 32 A2 DA 65 71
+ 65 72 2D 03 73 DA 2F 74 C5 19 01)
+ (|PORT|::|SERVENT| |COMMON-LISP|::|STRUCTURE-OBJECT| |CLOS|::|CLOSCLASS|
+ |CLOS|::|CLASS-NAMES| |SYSTEM|::|STRUCTURE-UNDEFINE-ACCESSORIES|
+ |SYSTEM|::|DEFSTRUCT-DESCRIPTION| |PORT|::|MAKE-SERVENT|
+ |PORT|::|COPY-SERVENT| |PORT|::|SERVENT-P|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME| |PORT|::|NAME|
+ :|INITARGS| (:|NAME|) :|TYPE| |COMMON-LISP|::|SIMPLE-STRING| :|ALLOCATION|
+ :|INSTANCE| |CLOS|::|INHERITABLE-INITER| #1=""
+ |SYSTEM|::|MAKE-CONSTANT-INITFUNCTION|
+ |CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| |CLOS|::|INHERITABLE-DOC|
+ (|COMMON-LISP|::|NIL|) |CLOS|::|LOCATION| 1. |CLOS|::|READONLY|
+ |CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |PORT|::|ALIASES| (:|ALIASES|) |COMMON-LISP|::|LIST| (|COMMON-LISP|::|NIL|)
+ 2. |PORT|::|PORT| (:|PORT|) |COMMON-LISP|::|FIXNUM| -1.
+ (|COMMON-LISP|::|NIL|) 3. |PORT|::|PROTO| (:|PROTO|)
+ |COMMON-LISP|::|SYMBOL| :|TCP| (|COMMON-LISP|::|NIL|) 4.
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| (|COMMON-LISP|::|NIL|)
+ :|READERS| (|PORT|::|SERVENT-NAME|) :|WRITERS|
+ ((|COMMON-LISP|::|SETF| |PORT|::|SERVENT-NAME|))
+ |CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ (|COMMON-LISP|::|NIL|) (|PORT|::|SERVENT-ALIASES|)
+ ((|COMMON-LISP|::|SETF| |PORT|::|SERVENT-ALIASES|)) (|COMMON-LISP|::|NIL|)
+ (|PORT|::|SERVENT-PORT|) ((|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PORT|))
+ (|COMMON-LISP|::|NIL|) (|PORT|::|SERVENT-PROTO|)
+ ((|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PROTO|))
+ |CLOS|::|DEFINE-STRUCTURE-CLASS| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|MAKE-SERVENT|
+ #64Y(00 00 00 00 00 00 00 00 A6 1B 04 00 01 00 3B 04 02 CA FC 3D 03 3B
+ 02 02 CB FA 3B 01 02 CC F9 69 00 01 E2 72 45 E3 AD E4 B4 32 44 E3
+ AD E5 B3 32 44 E3 AD E6 B2 32 44 E3 AD E7 B1 32 44 15 19 05)
+ (|COMMON-LISP|::|NIL| :|NAME| :|ALIASES| :|PORT| :|PROTO| #1# -1. :|TCP|
+ 5. |PORT|::|SERVENT| 1. 2. 3. 4.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|&KEY| (#:|NAME| #1#) (#:|ALIASES| |COMMON-LISP|::|NIL|)
+ (#:|PORT| -1.) (#:|PROTO| :|TCP|))
+ |COMMON-LISP|::|NIL| 1)
+ (|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-P|) |SYSTEM|::|INLINE-EXPANSION|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|SERVENT-P|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-P|
+ (|SYSTEM|::|%STRUCTURE-TYPE-P| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT|)))
+ #Y(|PORT|::|SERVENT-P|
+ #16Y(00 00 00 00 01 00 00 00 20 02 DA AE 32 47 19 02)
+ (|PORT|::|SERVENT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|INLINE| |PORT|::|COPY-SERVENT|)
+ ((|COMMON-LISP|::|STRUCTURE|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|COPY-SERVENT|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|COPY-SERVENT|
+ (|COMMON-LISP|::|COPY-STRUCTURE| |COMMON-LISP|::|STRUCTURE|)))
+ #Y(|PORT|::|COPY-SERVENT|
+ #15Y(00 00 00 00 01 00 00 00 26 02 AD 32 46 19 02) ()
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|STRUCTURE|) |COMMON-LISP|::|NIL| 1)
+ (|COMMON-LISP|::|FUNCTION| |PORT|::|SERVENT-NAME| (|PORT|::|SERVENT|)
+ |COMMON-LISP|::|SIMPLE-STRING|)
+ (|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-NAME|) |PORT|::|SERVENT-NAME|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|SERVENT-NAME|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-NAME|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 1.))))
+ #Y(|PORT|::|SERVENT-NAME|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|PORT|::|SERVENT| 1.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ |SYSTEM|::|DEFSTRUCT-READER|
+ (|COMMON-LISP|::|FUNCTION| |PORT|::|SERVENT-ALIASES| (|PORT|::|SERVENT|)
+ |COMMON-LISP|::|LIST|)
+ (|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-ALIASES|)
+ |PORT|::|SERVENT-ALIASES|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| |PORT|::|SERVENT-ALIASES|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-ALIASES|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 2.))))
+ #Y(|PORT|::|SERVENT-ALIASES|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|PORT|::|SERVENT| 2.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|FUNCTION| |PORT|::|SERVENT-PORT| (|PORT|::|SERVENT|)
+ |COMMON-LISP|::|FIXNUM|)
+ (|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-PORT|) |PORT|::|SERVENT-PORT|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|SERVENT-PORT|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-PORT|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 3.))))
+ #Y(|PORT|::|SERVENT-PORT|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|PORT|::|SERVENT| 3.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|FUNCTION| |PORT|::|SERVENT-PROTO| (|PORT|::|SERVENT|)
+ |COMMON-LISP|::|SYMBOL|)
+ (|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-PROTO|) |PORT|::|SERVENT-PROTO|
+ ((|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|SERVENT-PROTO|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-PROTO|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SYMBOL|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 4.))))
+ #Y(|PORT|::|SERVENT-PROTO|
+ #17Y(00 00 00 00 01 00 00 00 20 02 DA AE DB 32 43 19 02)
+ (|PORT|::|SERVENT| 4.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-NAME|)
+ (|COMMON-LISP|::|SIMPLE-STRING| |PORT|::|SERVENT|)
+ |COMMON-LISP|::|SIMPLE-STRING|)
+ (|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-NAME|))
+ #.(|SYSTEM|::|GET-SETF-SYMBOL| '|PORT|::|SERVENT-NAME|)
+ ((|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| #2=(|COMMON-LISP|::|SETF| |PORT|::|SERVENT-NAME|)))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-NAME|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 1.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING| .
+ #3=(|SYSTEM|::|VALUE|)))))
+ #Y(#2# #18Y(00 00 00 00 02 00 00 00 20 03 DA AE DB B1 32 44 19 03)
+ (|PORT|::|SERVENT| 1.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |SYSTEM|::|DEFSTRUCT-WRITER|
+ (|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-ALIASES|)
+ (|COMMON-LISP|::|LIST| |PORT|::|SERVENT|) |COMMON-LISP|::|LIST|)
+ (|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-ALIASES|))
+ #.(|SYSTEM|::|GET-SETF-SYMBOL| '|PORT|::|SERVENT-ALIASES|)
+ ((|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN|
+ #4=(|COMMON-LISP|::|SETF| |PORT|::|SERVENT-ALIASES|)))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-ALIASES|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 2.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST| . #3#))))
+ #Y(#4# #18Y(00 00 00 00 02 00 00 00 20 03 DA AE DB B1 32 44 19 03)
+ (|PORT|::|SERVENT| 2.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ (|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PORT|)
+ (|COMMON-LISP|::|FIXNUM| |PORT|::|SERVENT|) |COMMON-LISP|::|FIXNUM|)
+ (|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PORT|))
+ #.(|SYSTEM|::|GET-SETF-SYMBOL| '|PORT|::|SERVENT-PORT|)
+ ((|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| #5=(|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PORT|)))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-PORT|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 3.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM| . #3#))))
+ #Y(#5# #18Y(00 00 00 00 02 00 00 00 20 03 DA AE DB B1 32 44 19 03)
+ (|PORT|::|SERVENT| 3.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ (|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PROTO|)
+ (|COMMON-LISP|::|SYMBOL| |PORT|::|SERVENT|) |COMMON-LISP|::|SYMBOL|)
+ (|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PROTO|))
+ #.(|SYSTEM|::|GET-SETF-SYMBOL| '|PORT|::|SERVENT-PROTO|)
+ ((|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN|
+ #6=(|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PROTO|)))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-PROTO|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 4.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SYMBOL| . #3#))))
+ #Y(#6# #18Y(00 00 00 00 02 00 00 00 20 03 DA AE DB B1 32 44 19 03)
+ (|PORT|::|SERVENT| 4.)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+ |COMMON-LISP|::|TYPE| "see getservbyname(3) for details"
+ |SYSTEM|::|%SET-DOCUMENTATION|
+ |CLOS|::|DEFSTRUCT-REMOVE-PRINT-OBJECT-METHOD|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|742 776 (DEFUN SOCKET-SERVICE-PORT (&OPTIONAL SERVICE #) ...)-38|
+ #20Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 DA DC 32 9C C5 19 01)
+ (|PORT|::|SOCKET-SERVICE-PORT| |SYSTEM|::|REMOVE-OLD-DEFINITIONS|
+ #Y(|PORT|::|SOCKET-SERVICE-PORT|
+ #239Y(03 00 01 00 00 00 02 00 26 0C 3D 02 3B 01 02 C5 F9 DB DC 38 05 72
+ 0B 53 80 C6 C8 45 01 07 1B 80 97 AD 72 62 8E AC 80 90 DE AE DF 71
+ 32 90 01 07 80 86 E0 E1 AF DF DE B2 38 06 72 7A 72 60 38 07 72 74
+ 2F 08 FA 78 71 51 38 02 80 4E 06 63 A0 5C 5C 79 1B 3E B8 B0 38 04
+ 8D 41 80 5C B9 B3 38 04 8C 41 09 B9 B2 E3 38 02 8D C1 80 4C E4 B3
+ E5 B4 E6 B5 E7 B6 2D 08 0E 16 07 1B 80 50 E9 EA BB BB 33 03 1E 94
+ 00 AC 71 51 38 02 71 4E 84 02 16 01 83 00 AC 8D 9F 6D 16 01 AC 31
+ B1 16 01 FD 9F 5C 5B FC 9F 5C 5C 5B FB 92 0D FF A9 E4 B3 E5 B4 E6
+ B5 E7 B6 6E 08 0E 84 00 B6 01 02 38 01 80 82 01 1C FF 5E 92 0D FF
+ B5 AC 31 B1 16 07 41 05 00 00 02 1D 03 14 2F 11 46 54 05 00 00 00
+ 1D 0E 1B 06 05 00 00 00 1D 06 14 EC 64 2D 03 11 55 19 04)
+ (#1="tcp" "/etc/services" :|INPUT| #.#'|COMMON-LISP|::|VALUES| #\# 0.
+ #\Space #\/ |PORT|::|STRING-TOKENS| #.#'|COMMON-LISP|::|STRING-EQUAL|
+ :|NAME| :|ALIASES| :|PORT| :|PROTO| |PORT|::|MAKE-SERVENT|
+ "~s: service ~s is not found for protocol ~s"
+ |PORT|::|SOCKET-SERVICE-PORT| |COMMON-LISP|::|CLOSE| :|ABORT|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|)
+ (|COMMON-LISP|::|&OPTIONAL| |PORT|::|SERVICE| (|PORT|::|PROTOCOL| #1#))
+ "Return the SERVENT structure corresponding to the SERVICE.\n
+When SERVICE is NIL, return the list of all services."
+ 1))
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
+#Y(#:|778 780 (PROVIDE :PORT-NET)-39|
+ #15Y(00 00 00 00 00 00 00 00 20 01 DA 2F 01 19 01)
+ (:|PORT-NET| |COMMON-LISP|::|PROVIDE|)
+ (|COMMON-LISP|::|T| |COMMON-LISP|::|T| |COMMON-LISP|::|T|))
Added: clfswm/contrib/server/net.lib
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/net.lib Thu Aug 12 17:30:52 2010
@@ -0,0 +1,988 @@
+#0Y_ #0Y |CHARSET|::|UTF-8|
+(|COMMON-LISP|::|SETQ| |COMMON-LISP|::|*PACKAGE*|
+ (|SYSTEM|::|%FIND-PACKAGE| "CL-USER"))
+(|SYSTEM|::|%IN-PACKAGE| "PORT" :|NICKNAMES| '|COMMON-LISP|::|NIL| :|USE|
+ '|COMMON-LISP|::|NIL| :|CASE-SENSITIVE| |COMMON-LISP|::|NIL| :|CASE-INVERTED|
+ |COMMON-LISP|::|NIL|)
+(|COMMON-LISP|::|USE-PACKAGE| '("COMMON-LISP") "PORT")
+(|SYSTEM|::|INTERN-EXPORT|
+ '("RESOLVE-HOST-IPADDR" "IPADDR-TO-DOTTED" "DOTTED-TO-IPADDR" "IPADDR-CLOSURE"
+ "HOSTENT" "HOSTENT-NAME" "HOSTENT-ALIASES" "HOSTENT-ADDR-LIST"
+ "HOSTENT-ADDR-TYPE" "SOCKET" "OPEN-SOCKET" "SOCKET-HOST/PORT"
+ "SOCKET-STRING" "SOCKET-SERVER" "SET-SOCKET-STREAM-FORMAT" "SOCKET-ACCEPT"
+ "OPEN-SOCKET-SERVER" "SOCKET-SERVER-CLOSE" "SOCKET-SERVER-HOST/PORT"
+ "SOCKET-SERVICE-PORT" "SERVENT-NAME" "SERVENT-ALIASES" "SERVENT-PORT"
+ "SERVENT-PROTO" "SERVENT-P" "SERVENT" "NETWORK" "TIMEOUT" "LOGIN"
+ "NET-PATH")
+ "PORT" |COMMON-LISP|::|NIL|)
+(|COMMON-LISP|::|FIND-PACKAGE| "PORT")
+(|COMMON-LISP|::|SETQ| |COMMON-LISP|::|*PACKAGE*|
+ (|SYSTEM|::|%FIND-PACKAGE| "PORT"))
+(|COMMON-LISP|::|LET*| ((#1=#:|G46976| |CLOS|::|<STANDARD-CLASS>|))
+ (|COMMON-LISP|::|APPLY| #'|CLOS|::|ENSURE-CLASS| '|PORT|::|CODE|
+ :|DIRECT-SUPERCLASSES| (|COMMON-LISP|::|LIST| '|COMMON-LISP|::|ERROR|)
+ :|DIRECT-SLOTS|
+ (|COMMON-LISP|::|LIST|
+ (|COMMON-LISP|::|LIST| :|NAME| '|PORT|::|PROC| :|READERS|
+ '(|PORT|::|CODE-PROC|) :|INITARGS| '(:|PROC|) :|INITFORM|
+ '|COMMON-LISP|::|NIL| :|INITFUNCTION|
+ (|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| |COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|LIST| :|NAME| '|PORT|::|MESG| :|READERS|
+ '(|PORT|::|CODE-MESG|) :|INITARGS| '(:|MESG|) :|INITFORM|
+ '|COMMON-LISP|::|NIL| :|INITFUNCTION|
+ (|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| |COMMON-LISP|::|NIL|) :|TYPE|
+ '(|COMMON-LISP|::|OR| |COMMON-LISP|::|NULL|
+ |COMMON-LISP|::|SIMPLE-STRING|))
+ (|COMMON-LISP|::|LIST| :|NAME| '|PORT|::|ARGS| :|READERS|
+ '(|PORT|::|CODE-ARGS|) :|INITARGS| '(:|ARGS|) :|INITFORM|
+ '|COMMON-LISP|::|NIL| :|INITFUNCTION|
+ (|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| |COMMON-LISP|::|NIL|) :|TYPE|
+ '|COMMON-LISP|::|LIST|))
+ :|METACLASS| #1# :|DOCUMENTATION| '"An error in the user code."
+ (|COMMON-LISP|::|APPEND| '(:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|LIST| :|DIRECT-DEFAULT-INITARGS| |COMMON-LISP|::|NIL|
+ :|GENERIC-ACCESSORS| '|COMMON-LISP|::|T|))))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|CODE-PROC|
+ #(1. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|SYSTEM|::|C-DEFUN| '|PORT|::|CODE-MESG|
+ #(1. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|SYSTEM|::|C-DEFUN| '|PORT|::|CODE-ARGS|
+ #(1. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|SYSTEM|::|C-DEFUN| '|CLOS|::|PRINT-OBJECT|
+ #(2. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|COMMON-LISP|::|LET*| ((#1=#:|G47050| |CLOS|::|<STANDARD-CLASS>|))
+ (|COMMON-LISP|::|APPLY| #'|CLOS|::|ENSURE-CLASS| '|PORT|::|CASE-ERROR|
+ :|DIRECT-SUPERCLASSES| (|COMMON-LISP|::|LIST| '|PORT|::|CODE|)
+ :|DIRECT-SLOTS|
+ (|COMMON-LISP|::|LIST|
+ (|COMMON-LISP|::|LIST| :|NAME| '|PORT|::|MESG| :|READERS|
+ '(|PORT|::|CODE-MESG|) :|INITFORM|
+ '#2="`~s' evaluated to `~s', not one of [~@{`~s'~^ ~}]" :|INITFUNCTION|
+ (|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| #2#) :|TYPE|
+ '|COMMON-LISP|::|SIMPLE-STRING|))
+ :|METACLASS| #1# :|DOCUMENTATION|
+ '"An error in a case statement.\n
+This carries the function name which makes the error message more useful."
+ (|COMMON-LISP|::|APPEND| '(:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|LIST| :|DIRECT-DEFAULT-INITARGS| |COMMON-LISP|::|NIL|
+ :|GENERIC-ACCESSORS| '|COMMON-LISP|::|T|))))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|CODE-MESG|
+ #(1. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|COMMON-LISP|::|LET*| ((#1=#:|G47061| |CLOS|::|<STANDARD-CLASS>|))
+ (|COMMON-LISP|::|APPLY| #'|CLOS|::|ENSURE-CLASS| '|PORT|::|NOT-IMPLEMENTED|
+ :|DIRECT-SUPERCLASSES| (|COMMON-LISP|::|LIST| '|PORT|::|CODE|)
+ :|DIRECT-SLOTS|
+ (|COMMON-LISP|::|LIST|
+ (|COMMON-LISP|::|LIST| :|NAME| '|PORT|::|MESG| :|READERS|
+ '(|PORT|::|CODE-MESG|) :|INITFORM| '#2="not implemented for ~a [~a]"
+ :|INITFUNCTION| (|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| #2#) :|TYPE|
+ '|COMMON-LISP|::|SIMPLE-STRING|)
+ (|COMMON-LISP|::|LIST| :|NAME| '|PORT|::|ARGS| :|READERS|
+ '(|PORT|::|CODE-ARGS|) :|INITFORM|
+ '#3=(|COMMON-LISP|::|LIST| (|COMMON-LISP|::|LISP-IMPLEMENTATION-TYPE|)
+ (|COMMON-LISP|::|LISP-IMPLEMENTATION-VERSION|))
+ :|INITFUNCTION|
+ (|COMMON-LISP|::|FUNCTION| |PORT|::|DEFAULT-ARGS|
+ (|COMMON-LISP|::|LAMBDA| |COMMON-LISP|::|NIL| #3#))
+ :|TYPE| '|COMMON-LISP|::|LIST|))
+ :|METACLASS| #1# :|DOCUMENTATION|
+ '"Your implementation does not support this functionality."
+ (|COMMON-LISP|::|APPEND| '(:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|LIST| :|DIRECT-DEFAULT-INITARGS| |COMMON-LISP|::|NIL|
+ :|GENERIC-ACCESSORS| '|COMMON-LISP|::|T|))))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|CODE-MESG|
+ #(1. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|SYSTEM|::|C-DEFUN| '|PORT|::|CODE-ARGS|
+ #(1. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|SYSTEM|::|REMOVE-OLD-DEFINITIONS| '|PORT|::|WITH-GENSYMS|)
+(|SYSTEM|::|%PUTD| '|PORT|::|WITH-GENSYMS|
+ (|SYSTEM|::|MAKE-MACRO|
+ (|COMMON-LISP|::|FUNCTION| |PORT|::|WITH-GENSYMS|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|CONS| |SYSTEM|::|<MACRO-FORM>|))
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|IGNORE| |SYSTEM|::|<ENV-ARG>|))
+ "Bind symbols in NAMES to gensyms. TITLE is a string - `gensym' prefix.\n
+Inspired by Paul Graham, <On Lisp>, p. 145."
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<MACRO-FORM>| 2. 2.
+ |COMMON-LISP|::|T|))
+ (|SYSTEM|::|MACRO-CALL-ERROR| |SYSTEM|::|<MACRO-FORM>|)
+ (|COMMON-LISP|::|LET*|
+ ((#1=#:|G47080| (|COMMON-LISP|::|CADR| . #2=(|SYSTEM|::|<MACRO-FORM>|)))
+ (#3=#:|G47081|
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| #1# 1. 1. |COMMON-LISP|::|T|))
+ (|SYSTEM|::|ERROR-OF-TYPE| '|EXT|::|SOURCE-PROGRAM-ERROR| :|FORM|
+ |SYSTEM|::|<MACRO-FORM>| :|DETAIL| #1#
+ (|SYSTEM|::|TEXT| "~S: ~S does not match lambda list element ~:S")
+ '|PORT|::|WITH-GENSYMS| #1#
+ '#4=(|PORT|::|TITLE| |COMMON-LISP|::|&REST| |PORT|::|NAMES|))
+ #1#))
+ (|PORT|::|TITLE| (|COMMON-LISP|::|CAR| #3#))
+ (|PORT|::|NAMES| (|COMMON-LISP|::|CDR| #3#))
+ (|PORT|::|BODY| (|COMMON-LISP|::|CDDR| . #2#)))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|WITH-GENSYMS|
+ `(|COMMON-LISP|::|LET|
+ (,@(|COMMON-LISP|::|MAPCAR|
+ (|COMMON-LISP|::|LAMBDA| (|PORT|::|SY|)
+ `(,|PORT|::|SY|
+ (|COMMON-LISP|::|GENSYM|
+ ,(|COMMON-LISP|::|CONCATENATE| '|COMMON-LISP|::|STRING|
+ |PORT|::|TITLE| (|COMMON-LISP|::|SYMBOL-NAME| |PORT|::|SY|)
+ "-"))))
+ |PORT|::|NAMES|))
+ ,@|PORT|::|BODY|))))))
+ '(#4# |COMMON-LISP|::|&BODY| |PORT|::|BODY|)))
+(|SYSTEM|::|REMOVE-OLD-DEFINITIONS| '|PORT|::|DEFCONST|)
+(|SYSTEM|::|%PUTD| '|PORT|::|DEFCONST|
+ (|SYSTEM|::|MAKE-MACRO|
+ (|COMMON-LISP|::|FUNCTION| |PORT|::|DEFCONST|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|CONS| |SYSTEM|::|<MACRO-FORM>|))
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|IGNORE| |SYSTEM|::|<ENV-ARG>|))
+ "Define a typed constant."
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<MACRO-FORM>| 5. 5.
+ |COMMON-LISP|::|NIL|))
+ (|SYSTEM|::|MACRO-CALL-ERROR| |SYSTEM|::|<MACRO-FORM>|)
+ (|COMMON-LISP|::|LET*|
+ ((|PORT|::|NAME| (|COMMON-LISP|::|CADR| . #1=(|SYSTEM|::|<MACRO-FORM>|)))
+ (|COMMON-LISP|::|TYPE| (|COMMON-LISP|::|CADDR| . #1#))
+ (|PORT|::|INIT| (|COMMON-LISP|::|CADDDR| . #1#))
+ (|PORT|::|DOC| (|COMMON-LISP|::|FIFTH| . #1#)))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|DEFCONST|
+ `(|COMMON-LISP|::|PROGN|
+ (|COMMON-LISP|::|DECLAIM|
+ (|COMMON-LISP|::|TYPE| ,|COMMON-LISP|::|TYPE| ,|PORT|::|NAME|))
+ (,(|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|SUBTYPEP| |COMMON-LISP|::|TYPE|
+ '(|COMMON-LISP|::|OR| |COMMON-LISP|::|SYMBOL|
+ |COMMON-LISP|::|NUMBER| |COMMON-LISP|::|CHARACTER|))
+ '|COMMON-LISP|::|DEFCONSTANT| '|COMMON-LISP|::|DEFVAR|)
+ ,|PORT|::|NAME|
+ (|COMMON-LISP|::|THE| ,|COMMON-LISP|::|TYPE| ,|PORT|::|INIT|)
+ ,|PORT|::|DOC|)))))))
+ '(|PORT|::|NAME| |COMMON-LISP|::|TYPE| |PORT|::|INIT| |PORT|::|DOC|)))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|TYPE| |COMMON-LISP|::|CONS| |PORT|::|+EOF+|))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|SPECIAL| |PORT|::|+EOF+|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|STRING-TOKENS|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|STRING| |COMMON-LISP|::|&KEY| (|PORT|::|START| 0.)
+ |PORT|::|END| |COMMON-LISP|::|MAX|
+ ((:|PACKAGE| |COMMON-LISP|::|*PACKAGE*|)
+ (|COMMON-LISP|::|FIND-PACKAGE| :|KEYWORD|)))))
+(|SYSTEM|::|REMOVE-OLD-DEFINITIONS| '|PORT|::|COMPOSE|)
+(|SYSTEM|::|%PUTD| '|PORT|::|COMPOSE|
+ (|SYSTEM|::|MAKE-MACRO|
+ (|COMMON-LISP|::|FUNCTION| |PORT|::|COMPOSE|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<MACRO-FORM>| |SYSTEM|::|<ENV-ARG>|)
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|CONS| |SYSTEM|::|<MACRO-FORM>|))
+ (|COMMON-LISP|::|DECLARE| (|COMMON-LISP|::|IGNORE| |SYSTEM|::|<ENV-ARG>|))
+ "Macro: compose functions or macros of 1 argument into a lambda.\n
+E.g., (compose abs (dl-val zz) 'key) ==>\n
+ (lambda (yy) (abs (funcall (dl-val zz) (funcall key yy))))"
+ (|COMMON-LISP|::|LET*|
+ ((|PORT|::|FUNCTIONS| (|COMMON-LISP|::|CDR| |SYSTEM|::|<MACRO-FORM>|)))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|COMPOSE|
+ (|COMMON-LISP|::|LABELS|
+ ((|PORT|::|REC| (|PORT|::|XX| |PORT|::|YY|)
+ (|COMMON-LISP|::|LET|
+ ((|PORT|::|RR|
+ (|COMMON-LISP|::|LIST| (|COMMON-LISP|::|CAR| |PORT|::|XX|)
+ (|COMMON-LISP|::|IF| (|COMMON-LISP|::|CDR| |PORT|::|XX|)
+ (|PORT|::|REC| (|COMMON-LISP|::|CDR| |PORT|::|XX|) |PORT|::|YY|)
+ |PORT|::|YY|))))
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|CONSP| (|COMMON-LISP|::|CAR| |PORT|::|XX|))
+ (|COMMON-LISP|::|CONS| '|COMMON-LISP|::|FUNCALL|
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|EQ| (|COMMON-LISP|::|CAAR| |PORT|::|XX|)
+ '|COMMON-LISP|::|QUOTE|)
+ (|COMMON-LISP|::|CONS| (|COMMON-LISP|::|CADAR| |PORT|::|XX|)
+ (|COMMON-LISP|::|CDR| |PORT|::|RR|))
+ |PORT|::|RR|))
+ |PORT|::|RR|))))
+ (|PORT|::|WITH-GENSYMS| ("COMPOSE-" |PORT|::|ARG|)
+ `(|COMMON-LISP|::|LAMBDA| (,|PORT|::|ARG|)
+ ,(|PORT|::|REC| |PORT|::|FUNCTIONS| |PORT|::|ARG|))))))))
+ '(|COMMON-LISP|::|&REST| |PORT|::|FUNCTIONS|)))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FTYPE|
+ (|COMMON-LISP|::|FUNCTION| ((|COMMON-LISP|::|UNSIGNED-BYTE| 32.))
+ (|COMMON-LISP|::|VALUES| |COMMON-LISP|::|SIMPLE-STRING|))
+ |PORT|::|IPADDR-TO-DOTTED|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|IPADDR-TO-DOTTED|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|PORT|::|IPADDR|)))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FTYPE|
+ (|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|STRING|)
+ (|COMMON-LISP|::|VALUES| (|COMMON-LISP|::|UNSIGNED-BYTE| 32.)))
+ |PORT|::|DOTTED-TO-IPADDR|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|DOTTED-TO-IPADDR|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|PORT|::|DOTTED|)))
+(|COMMON-LISP|::|LET| |COMMON-LISP|::|NIL|
+ (|COMMON-LISP|::|LET|
+ ((#1=#:|G47213|
+ (|COMMON-LISP|::|CONS| '|PORT|::|HOSTENT|
+ (|CLOS|::|CLASS-NAMES|
+ (|COMMON-LISP|::|GET| '|COMMON-LISP|::|STRUCTURE-OBJECT|
+ '|CLOS|::|CLOSCLASS|)))))
+ (|SYSTEM|::|STRUCTURE-UNDEFINE-ACCESSORIES| '|PORT|::|HOSTENT|)
+ (|COMMON-LISP|::|REMPROP| '|PORT|::|HOSTENT|
+ '|SYSTEM|::|DEFSTRUCT-DESCRIPTION|)
+ (|CLOS|::|DEFINE-STRUCTURE-CLASS| '|PORT|::|HOSTENT| #1#
+ '|PORT|::|MAKE-HOSTENT| '|COMMON-LISP|::|NIL| '|PORT|::|COPY-HOSTENT|
+ '|PORT|::|HOSTENT-P|
+ (|COMMON-LISP|::|LIST|
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME| '|PORT|::|NAME|
+ :|INITARGS| '#2=(:|NAME|) :|TYPE| '|COMMON-LISP|::|SIMPLE-STRING|
+ :|ALLOCATION| ':|INSTANCE| #3='|CLOS|::|INHERITABLE-INITER|
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '#4=""
+ #5=(|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| #4#))
+ #6='|CLOS|::|INHERITABLE-DOC| '(|COMMON-LISP|::|NIL|)
+ #7='|CLOS|::|LOCATION| '1. #8='|CLOS|::|READONLY| '|COMMON-LISP|::|NIL|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME| '|PORT|::|ALIASES|
+ :|INITARGS| '#9=(:|ALIASES|) :|TYPE| '|COMMON-LISP|::|LIST| :|ALLOCATION|
+ ':|INSTANCE| #3#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '|COMMON-LISP|::|NIL|
+ #10=(|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| |COMMON-LISP|::|NIL|))
+ #6# '(|COMMON-LISP|::|NIL|) #7# '2. #8# '|COMMON-LISP|::|NIL|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME|
+ '|PORT|::|ADDR-LIST| :|INITARGS| '#11=(:|ADDR-LIST|) :|TYPE|
+ '|COMMON-LISP|::|LIST| :|ALLOCATION| ':|INSTANCE| #3#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '|COMMON-LISP|::|NIL|
+ #12=(|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| |COMMON-LISP|::|NIL|))
+ #6# '(|COMMON-LISP|::|NIL|) #7# '3. #8# '|COMMON-LISP|::|NIL|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME|
+ '|PORT|::|ADDR-TYPE| :|INITARGS| '#13=(:|ADDR-TYPE|) :|TYPE|
+ '|COMMON-LISP|::|FIXNUM| :|ALLOCATION| ':|INSTANCE| #3#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '2.
+ #14=(|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| 2.))
+ #6# '(|COMMON-LISP|::|NIL|) #7# '4. #8# '|COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|LIST|
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME| '|PORT|::|NAME|
+ :|INITARGS| '#2# :|TYPE| '|COMMON-LISP|::|SIMPLE-STRING| :|ALLOCATION|
+ ':|INSTANCE| #15='|CLOS|::|INHERITABLE-INITER|
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '#4# #5#)
+ #16='|CLOS|::|INHERITABLE-DOC| '(|COMMON-LISP|::|NIL|) :|READERS|
+ '(|PORT|::|HOSTENT-NAME|) :|WRITERS|
+ '((|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-NAME|)))
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME| '|PORT|::|ALIASES|
+ :|INITARGS| '#9# :|TYPE| '|COMMON-LISP|::|LIST| :|ALLOCATION| ':|INSTANCE|
+ #15#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '|COMMON-LISP|::|NIL|
+ #10#)
+ #16# '(|COMMON-LISP|::|NIL|) :|READERS| '(|PORT|::|HOSTENT-ALIASES|)
+ :|WRITERS| '((|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ALIASES|)))
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME| '|PORT|::|ADDR-LIST|
+ :|INITARGS| '#11# :|TYPE| '|COMMON-LISP|::|LIST| :|ALLOCATION|
+ ':|INSTANCE| #15#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '|COMMON-LISP|::|NIL|
+ #12#)
+ #16# '(|COMMON-LISP|::|NIL|) :|READERS| '(|PORT|::|HOSTENT-ADDR-LIST|)
+ :|WRITERS| '((|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-LIST|)))
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME| '|PORT|::|ADDR-TYPE|
+ :|INITARGS| '#13# :|TYPE| '|COMMON-LISP|::|FIXNUM| :|ALLOCATION|
+ ':|INSTANCE| #15#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '2. #14#) #16#
+ '(|COMMON-LISP|::|NIL|) :|READERS| '(|PORT|::|HOSTENT-ADDR-TYPE|)
+ :|WRITERS| '((|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-TYPE|)))))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|MAKE-HOSTENT|
+ (|COMMON-LISP|::|&KEY| (#17=#:|NAME| #4#)
+ (#18=#:|ALIASES| |COMMON-LISP|::|NIL|)
+ (#19=#:|ADDR-LIST| |COMMON-LISP|::|NIL|) (#20=#:|ADDR-TYPE| 2.))
+ (|COMMON-LISP|::|LET|
+ ((|SYSTEM|::|OBJECT| (|SYSTEM|::|%MAKE-STRUCTURE| #1# 5.)))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 1.)
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING| #17#))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 2.)
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST| #18#))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 3.)
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST| #19#))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 4.)
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM| #20#))
+ |SYSTEM|::|OBJECT|)))
+ (|COMMON-LISP|::|PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-P|))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|HOSTENT-P| (|SYSTEM|::|OBJECT|)
+ (|SYSTEM|::|%STRUCTURE-TYPE-P| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT|))
+ (|COMMON-LISP|::|PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|COPY-HOSTENT|))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|COPY-HOSTENT| (|COMMON-LISP|::|STRUCTURE|)
+ (|COMMON-LISP|::|COPY-STRUCTURE| |COMMON-LISP|::|STRUCTURE|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|HOSTENT-NAME| (|PORT|::|HOSTENT|)
+ |COMMON-LISP|::|SIMPLE-STRING|))
+ (|COMMON-LISP|::|PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-NAME|))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|HOSTENT-NAME| #21=(|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 1.)))
+ (|SYSTEM|::|%PUT| '|PORT|::|HOSTENT-NAME| #22='|SYSTEM|::|DEFSTRUCT-READER|
+ '|PORT|::|HOSTENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|HOSTENT-ALIASES| (|PORT|::|HOSTENT|)
+ |COMMON-LISP|::|LIST|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-ALIASES|))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|HOSTENT-ALIASES| #21#
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 2.)))
+ (|SYSTEM|::|%PUT| '|PORT|::|HOSTENT-ALIASES| #22# '|PORT|::|HOSTENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|HOSTENT-ADDR-LIST| (|PORT|::|HOSTENT|)
+ |COMMON-LISP|::|LIST|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-ADDR-LIST|))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|HOSTENT-ADDR-LIST| #21#
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 3.)))
+ (|SYSTEM|::|%PUT| '|PORT|::|HOSTENT-ADDR-LIST| #22# '|PORT|::|HOSTENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|HOSTENT-ADDR-TYPE| (|PORT|::|HOSTENT|)
+ |COMMON-LISP|::|FIXNUM|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-ADDR-TYPE|))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|HOSTENT-ADDR-TYPE| #21#
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 4.)))
+ (|SYSTEM|::|%PUT| '|PORT|::|HOSTENT-ADDR-TYPE| #22# '|PORT|::|HOSTENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-NAME|)
+ (|COMMON-LISP|::|SIMPLE-STRING| |PORT|::|HOSTENT|)
+ |COMMON-LISP|::|SIMPLE-STRING|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-NAME|)))
+ (|COMMON-LISP|::|DEFUN| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-NAME|)
+ #23=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 1.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING| .
+ #24=(|SYSTEM|::|VALUE|))))
+ (|SYSTEM|::|%PUT| '|PORT|::|HOSTENT-NAME| #25='|SYSTEM|::|DEFSTRUCT-WRITER|
+ '|PORT|::|HOSTENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ALIASES|)
+ (|COMMON-LISP|::|LIST| |PORT|::|HOSTENT|) |COMMON-LISP|::|LIST|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ALIASES|)))
+ (|COMMON-LISP|::|DEFUN| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ALIASES|) #23#
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 2.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST| . #24#)))
+ (|SYSTEM|::|%PUT| '|PORT|::|HOSTENT-ALIASES| #25# '|PORT|::|HOSTENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-LIST|)
+ (|COMMON-LISP|::|LIST| |PORT|::|HOSTENT|) |COMMON-LISP|::|LIST|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-LIST|)))
+ (|COMMON-LISP|::|DEFUN| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-LIST|)
+ #23#
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 3.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST| . #24#)))
+ (|SYSTEM|::|%PUT| '|PORT|::|HOSTENT-ADDR-LIST| #25# '|PORT|::|HOSTENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-TYPE|)
+ (|COMMON-LISP|::|FIXNUM| |PORT|::|HOSTENT|) |COMMON-LISP|::|FIXNUM|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-TYPE|)))
+ (|COMMON-LISP|::|DEFUN| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-TYPE|)
+ #23#
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 4.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM| . #24#)))
+ (|SYSTEM|::|%PUT| '|PORT|::|HOSTENT-ADDR-TYPE| #25# '|PORT|::|HOSTENT|)
+ (|SYSTEM|::|%SET-DOCUMENTATION| '|PORT|::|HOSTENT| '|COMMON-LISP|::|TYPE|
+ "see gethostbyname(3) for details")
+ (|CLOS|::|DEFSTRUCT-REMOVE-PRINT-OBJECT-METHOD| '|PORT|::|HOSTENT|)
+ '|PORT|::|HOSTENT|)
+(|SYSTEM|::|C-DEFUN| '|PORT|::|MAKE-HOSTENT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|&KEY| (#:|NAME| "") (#:|ALIASES| |COMMON-LISP|::|NIL|)
+ (#:|ADDR-LIST| |COMMON-LISP|::|NIL|) (#:|ADDR-TYPE| 2.))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-P|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|HOSTENT-P|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|HOSTENT-P|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-P|
+ (|SYSTEM|::|%STRUCTURE-TYPE-P| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT|))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|COPY-HOSTENT|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|COPY-HOSTENT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|COMMON-LISP|::|STRUCTURE|))
+ '(#1# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|COPY-HOSTENT|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|COPY-HOSTENT|
+ (|COMMON-LISP|::|COPY-STRUCTURE| |COMMON-LISP|::|STRUCTURE|))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|HOSTENT-NAME| (|PORT|::|HOSTENT|)
+ |COMMON-LISP|::|SIMPLE-STRING|))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-NAME|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|HOSTENT-NAME|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|HOSTENT-NAME|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-NAME|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 1.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|HOSTENT-ALIASES| (|PORT|::|HOSTENT|)
+ |COMMON-LISP|::|LIST|))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-ALIASES|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|HOSTENT-ALIASES|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|HOSTENT-ALIASES|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-ALIASES|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 2.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|HOSTENT-ADDR-LIST| (|PORT|::|HOSTENT|)
+ |COMMON-LISP|::|LIST|))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-ADDR-LIST|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|HOSTENT-ADDR-LIST|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| |PORT|::|HOSTENT-ADDR-LIST|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-ADDR-LIST|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 3.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|HOSTENT-ADDR-TYPE| (|PORT|::|HOSTENT|)
+ |COMMON-LISP|::|FIXNUM|))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|HOSTENT-ADDR-TYPE|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|HOSTENT-ADDR-TYPE|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE|
+ (|SYSTEM|::|IN-DEFUN| |PORT|::|HOSTENT-ADDR-TYPE|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-ADDR-TYPE|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 4.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-NAME|)
+ (|COMMON-LISP|::|SIMPLE-STRING| |PORT|::|HOSTENT|)
+ |COMMON-LISP|::|SIMPLE-STRING|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-NAME|)))
+(|SYSTEM|::|C-DEFUN| '#1=(|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-NAME|)
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#2=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|))
+ '(#2# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| #1#))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-NAME|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 1.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING|
+ |SYSTEM|::|VALUE|)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ALIASES|)
+ (|COMMON-LISP|::|LIST| |PORT|::|HOSTENT|) |COMMON-LISP|::|LIST|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ALIASES|)))
+(|SYSTEM|::|C-DEFUN| '#1=(|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ALIASES|)
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#2=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|))
+ '(#2# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| #1#))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-ALIASES|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 2.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST| |SYSTEM|::|VALUE|)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-LIST|)
+ (|COMMON-LISP|::|LIST| |PORT|::|HOSTENT|) |COMMON-LISP|::|LIST|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-LIST|)))
+(|SYSTEM|::|C-DEFUN| '#1=(|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-LIST|)
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#2=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|))
+ '(#2# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| #1#))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-ADDR-LIST|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 3.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST| |SYSTEM|::|VALUE|)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-TYPE|)
+ (|COMMON-LISP|::|FIXNUM| |PORT|::|HOSTENT|) |COMMON-LISP|::|FIXNUM|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE|
+ (|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-TYPE|)))
+(|SYSTEM|::|C-DEFUN| '#1=(|COMMON-LISP|::|SETF| |PORT|::|HOSTENT-ADDR-TYPE|)
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#2=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|))
+ '(#2# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| #1#))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|HOSTENT-ADDR-TYPE|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|HOSTENT| |SYSTEM|::|OBJECT| 4.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM| |SYSTEM|::|VALUE|)))))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|RESOLVE-HOST-IPADDR|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|PORT|::|HOST|)))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|IPADDR-CLOSURE|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|PORT|::|ADDRESS|)))
+(|COMMON-LISP|::|LET| |COMMON-LISP|::|NIL|
+ (|SYSTEM|::|%PUT| '|PORT|::|SOCKET| '|SYSTEM|::|DEFTYPE-EXPANDER|
+ (|COMMON-LISP|::|FUNCTION| #:|DEFTYPE-SOCKET|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<DEFTYPE-FORM>|)
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|PROPER-LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<DEFTYPE-FORM>| 1.
+ 1.))
+ (|SYSTEM|::|TYPE-CALL-ERROR| |SYSTEM|::|<DEFTYPE-FORM>|)
+ (|COMMON-LISP|::|LET*| |COMMON-LISP|::|NIL|
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SOCKET| '|COMMON-LISP|::|STREAM|))))))
+ (|SYSTEM|::|%SET-DOCUMENTATION| '|PORT|::|SOCKET| '|COMMON-LISP|::|TYPE|
+ '|COMMON-LISP|::|NIL|)
+ '|PORT|::|SOCKET|)
+(|SYSTEM|::|C-DEFUN| '|PORT|::|OPEN-SOCKET|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|PORT|::|HOST| |PORT|::|PORT| |COMMON-LISP|::|&OPTIONAL| |PORT|::|BIN|)))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|SET-SOCKET-STREAM-FORMAT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|PORT|::|SOCKET| |COMMON-LISP|::|FORMAT|)))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|SOCKET-HOST/PORT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|PORT|::|SOCK|)))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|SOCKET-STRING|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|PORT|::|SOCK|)))
+(|COMMON-LISP|::|LET| |COMMON-LISP|::|NIL|
+ (|SYSTEM|::|%PUT| '|PORT|::|SOCKET-SERVER| '|SYSTEM|::|DEFTYPE-EXPANDER|
+ (|COMMON-LISP|::|FUNCTION| #:|DEFTYPE-SOCKET-SERVER|
+ (|COMMON-LISP|::|LAMBDA| (|SYSTEM|::|<DEFTYPE-FORM>|)
+ (|COMMON-LISP|::|IF|
+ (|COMMON-LISP|::|NOT|
+ (|SYSTEM|::|PROPER-LIST-LENGTH-IN-BOUNDS-P| |SYSTEM|::|<DEFTYPE-FORM>| 1.
+ 1.))
+ (|SYSTEM|::|TYPE-CALL-ERROR| |SYSTEM|::|<DEFTYPE-FORM>|)
+ (|COMMON-LISP|::|LET*| |COMMON-LISP|::|NIL|
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SOCKET-SERVER|
+ '|SOCKET|::|SOCKET-SERVER|))))))
+ (|SYSTEM|::|%SET-DOCUMENTATION| '|PORT|::|SOCKET-SERVER|
+ '|COMMON-LISP|::|TYPE| '|COMMON-LISP|::|NIL|)
+ '|PORT|::|SOCKET-SERVER|)
+(|SYSTEM|::|C-DEFUN| '|PORT|::|OPEN-SOCKET-SERVER|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|&OPTIONAL| |PORT|::|PORT|)))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|SOCKET-ACCEPT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|PORT|::|SERV| |COMMON-LISP|::|&KEY| |PORT|::|BIN| |PORT|::|WAIT|)))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|SOCKET-SERVER-CLOSE|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|PORT|::|SERVER|)))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|SOCKET-SERVER-HOST/PORT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|PORT|::|SERVER|)))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|WAIT-FOR-STREAM|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|STREAM| |COMMON-LISP|::|&OPTIONAL| |PORT|::|TIMEOUT|)))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|OPEN-UNIX-SOCKET|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|PORT|::|PATH| |COMMON-LISP|::|&KEY| (|PORT|::|KIND| :|STREAM|)
+ |PORT|::|BIN|)))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|REPORT-NETWORK-CONDITION|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '(|PORT|::|CC| |PORT|::|OUT|)))
+(|COMMON-LISP|::|LET*| ((#1=#:|G47479| |CLOS|::|<STANDARD-CLASS>|))
+ (|COMMON-LISP|::|APPLY| #'|CLOS|::|ENSURE-CLASS| '|PORT|::|NETWORK|
+ :|DIRECT-SUPERCLASSES| (|COMMON-LISP|::|LIST| '|COMMON-LISP|::|ERROR|)
+ :|DIRECT-SLOTS|
+ (|COMMON-LISP|::|LIST|
+ (|COMMON-LISP|::|LIST| :|NAME| '|PORT|::|PROC| :|READERS|
+ '(|PORT|::|NET-PROC|) :|INITARGS| '(:|PROC|) :|INITFORM|
+ '|COMMON-LISP|::|NIL| :|INITFUNCTION|
+ (|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| |COMMON-LISP|::|NIL|) :|TYPE|
+ '|COMMON-LISP|::|SYMBOL|)
+ (|COMMON-LISP|::|LIST| :|NAME| '|PORT|::|HOST| :|READERS|
+ '(|PORT|::|NET-HOST|) :|INITARGS| '(:|HOST|) :|INITFORM| '#2=""
+ :|INITFUNCTION| (|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| #2#) :|TYPE|
+ '|COMMON-LISP|::|SIMPLE-STRING|)
+ (|COMMON-LISP|::|LIST| :|NAME| '|PORT|::|PORT| :|READERS|
+ '(|PORT|::|NET-PORT|) :|INITARGS| '(:|PORT|) :|INITFORM| '0.
+ :|INITFUNCTION| (|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| 0.) :|TYPE|
+ '(|COMMON-LISP|::|UNSIGNED-BYTE| 16.))
+ (|COMMON-LISP|::|LIST| :|NAME| '|PORT|::|MESG| :|READERS|
+ '(|PORT|::|NET-MESG|) :|INITARGS| '(:|MESG|) :|INITFORM|
+ '|COMMON-LISP|::|NIL| :|INITFUNCTION|
+ (|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| |COMMON-LISP|::|NIL|) :|TYPE|
+ '(|COMMON-LISP|::|OR| |COMMON-LISP|::|NULL|
+ |COMMON-LISP|::|SIMPLE-STRING|))
+ (|COMMON-LISP|::|LIST| :|NAME| '|PORT|::|ARGS| :|READERS|
+ '(|PORT|::|NET-ARGS|) :|INITARGS| '(:|ARGS|) :|INITFORM|
+ '|COMMON-LISP|::|NIL| :|INITFUNCTION|
+ (|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| |COMMON-LISP|::|NIL|) :|TYPE|
+ '|COMMON-LISP|::|LIST|))
+ :|METACLASS| #1#
+ (|COMMON-LISP|::|APPEND| '(:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|LIST| :|DIRECT-DEFAULT-INITARGS| |COMMON-LISP|::|NIL|
+ :|DOCUMENTATION| |COMMON-LISP|::|NIL| :|GENERIC-ACCESSORS|
+ '|COMMON-LISP|::|T|))))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|NET-PROC|
+ #(1. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|SYSTEM|::|C-DEFUN| '|PORT|::|NET-HOST|
+ #(1. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|SYSTEM|::|C-DEFUN| '|PORT|::|NET-PORT|
+ #(1. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|SYSTEM|::|C-DEFUN| '|PORT|::|NET-MESG|
+ #(1. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|SYSTEM|::|C-DEFUN| '|PORT|::|NET-ARGS|
+ #(1. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|SYSTEM|::|C-DEFUN| '|CLOS|::|PRINT-OBJECT|
+ #(2. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|COMMON-LISP|::|LET*| ((#1=#:|G47552| |CLOS|::|<STANDARD-CLASS>|))
+ (|COMMON-LISP|::|APPLY| #'|CLOS|::|ENSURE-CLASS| '|PORT|::|TIMEOUT|
+ :|DIRECT-SUPERCLASSES| (|COMMON-LISP|::|LIST| '|PORT|::|NETWORK|)
+ :|DIRECT-SLOTS|
+ (|COMMON-LISP|::|LIST|
+ (|COMMON-LISP|::|LIST| :|NAME| '|COMMON-LISP|::|TIME| :|READERS|
+ '(|PORT|::|TIMEOUT-TIME|) :|INITARGS| '(:|TIME|) :|INITFORM| '0.
+ :|INITFUNCTION| (|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| 0.) :|TYPE|
+ '(|COMMON-LISP|::|REAL| 0.)))
+ :|METACLASS| #1#
+ (|COMMON-LISP|::|APPEND| '(:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|LIST| :|DIRECT-DEFAULT-INITARGS| |COMMON-LISP|::|NIL|
+ :|DOCUMENTATION| |COMMON-LISP|::|NIL| :|GENERIC-ACCESSORS|
+ '|COMMON-LISP|::|T|))))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|TIMEOUT-TIME|
+ #(1. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|SYSTEM|::|C-DEFUN| '|CLOS|::|PRINT-OBJECT|
+ #(2. 0. |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL| |COMMON-LISP|::|NIL|
+ |COMMON-LISP|::|NIL|)
+ |COMMON-LISP|::|NIL| '|CLOS|::|DEFMETHOD|)
+(|COMMON-LISP|::|LET*| ((#1=#:|G47608| |CLOS|::|<STANDARD-CLASS>|))
+ (|COMMON-LISP|::|APPLY| #'|CLOS|::|ENSURE-CLASS| '|PORT|::|LOGIN|
+ :|DIRECT-SUPERCLASSES| (|COMMON-LISP|::|LIST| '|PORT|::|NETWORK|)
+ :|DIRECT-SLOTS| (|COMMON-LISP|::|LIST|) :|METACLASS| #1#
+ (|COMMON-LISP|::|APPEND| '(:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|LIST| :|DIRECT-DEFAULT-INITARGS| |COMMON-LISP|::|NIL|
+ :|DOCUMENTATION| |COMMON-LISP|::|NIL| :|GENERIC-ACCESSORS|
+ '|COMMON-LISP|::|T|))))
+(|COMMON-LISP|::|LET*| ((#1=#:|G47612| |CLOS|::|<STANDARD-CLASS>|))
+ (|COMMON-LISP|::|APPLY| #'|CLOS|::|ENSURE-CLASS| '|PORT|::|NET-PATH|
+ :|DIRECT-SUPERCLASSES| (|COMMON-LISP|::|LIST| '|PORT|::|NETWORK|)
+ :|DIRECT-SLOTS| (|COMMON-LISP|::|LIST|) :|METACLASS| #1#
+ (|COMMON-LISP|::|APPEND| '(:|FIXED-SLOT-LOCATIONS| |COMMON-LISP|::|NIL|)
+ (|COMMON-LISP|::|LIST| :|DIRECT-DEFAULT-INITARGS| |COMMON-LISP|::|NIL|
+ :|DOCUMENTATION| |COMMON-LISP|::|NIL| :|GENERIC-ACCESSORS|
+ '|COMMON-LISP|::|T|))))
+(|COMMON-LISP|::|LET| |COMMON-LISP|::|NIL|
+ (|COMMON-LISP|::|LET|
+ ((#1=#:|G47616|
+ (|COMMON-LISP|::|CONS| '|PORT|::|SERVENT|
+ (|CLOS|::|CLASS-NAMES|
+ (|COMMON-LISP|::|GET| '|COMMON-LISP|::|STRUCTURE-OBJECT|
+ '|CLOS|::|CLOSCLASS|)))))
+ (|SYSTEM|::|STRUCTURE-UNDEFINE-ACCESSORIES| '|PORT|::|SERVENT|)
+ (|COMMON-LISP|::|REMPROP| '|PORT|::|SERVENT|
+ '|SYSTEM|::|DEFSTRUCT-DESCRIPTION|)
+ (|CLOS|::|DEFINE-STRUCTURE-CLASS| '|PORT|::|SERVENT| #1#
+ '|PORT|::|MAKE-SERVENT| '|COMMON-LISP|::|NIL| '|PORT|::|COPY-SERVENT|
+ '|PORT|::|SERVENT-P|
+ (|COMMON-LISP|::|LIST|
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME| '|PORT|::|NAME|
+ :|INITARGS| '#2=(:|NAME|) :|TYPE| '|COMMON-LISP|::|SIMPLE-STRING|
+ :|ALLOCATION| ':|INSTANCE| #3='|CLOS|::|INHERITABLE-INITER|
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '#4=""
+ #5=(|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| #4#))
+ #6='|CLOS|::|INHERITABLE-DOC| '(|COMMON-LISP|::|NIL|)
+ #7='|CLOS|::|LOCATION| '1. #8='|CLOS|::|READONLY| '|COMMON-LISP|::|NIL|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME| '|PORT|::|ALIASES|
+ :|INITARGS| '#9=(:|ALIASES|) :|TYPE| '|COMMON-LISP|::|LIST| :|ALLOCATION|
+ ':|INSTANCE| #3#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '|COMMON-LISP|::|NIL|
+ #10=(|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| |COMMON-LISP|::|NIL|))
+ #6# '(|COMMON-LISP|::|NIL|) #7# '2. #8# '|COMMON-LISP|::|NIL|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME| '|PORT|::|PORT|
+ :|INITARGS| '#11=(:|PORT|) :|TYPE| '|COMMON-LISP|::|FIXNUM| :|ALLOCATION|
+ ':|INSTANCE| #3#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '-1.
+ #12=(|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| -1.))
+ #6# '(|COMMON-LISP|::|NIL|) #7# '3. #8# '|COMMON-LISP|::|NIL|)
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-EFFECTIVE-SLOT-DEFINITION>| :|NAME| '|PORT|::|PROTO|
+ :|INITARGS| '#13=(:|PROTO|) :|TYPE| '|COMMON-LISP|::|SYMBOL| :|ALLOCATION|
+ ':|INSTANCE| #3#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| ':|TCP|
+ #14=(|SYSTEM|::|MAKE-CONSTANT-INITFUNCTION| :|TCP|))
+ #6# '(|COMMON-LISP|::|NIL|) #7# '4. #8# '|COMMON-LISP|::|NIL|))
+ (|COMMON-LISP|::|LIST|
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME| '|PORT|::|NAME|
+ :|INITARGS| '#2# :|TYPE| '|COMMON-LISP|::|SIMPLE-STRING| :|ALLOCATION|
+ ':|INSTANCE| #15='|CLOS|::|INHERITABLE-INITER|
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '#4# #5#)
+ #16='|CLOS|::|INHERITABLE-DOC| '(|COMMON-LISP|::|NIL|) :|READERS|
+ '(|PORT|::|SERVENT-NAME|) :|WRITERS|
+ '((|COMMON-LISP|::|SETF| |PORT|::|SERVENT-NAME|)))
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME| '|PORT|::|ALIASES|
+ :|INITARGS| '#9# :|TYPE| '|COMMON-LISP|::|LIST| :|ALLOCATION| ':|INSTANCE|
+ #15#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '|COMMON-LISP|::|NIL|
+ #10#)
+ #16# '(|COMMON-LISP|::|NIL|) :|READERS| '(|PORT|::|SERVENT-ALIASES|)
+ :|WRITERS| '((|COMMON-LISP|::|SETF| |PORT|::|SERVENT-ALIASES|)))
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME| '|PORT|::|PORT|
+ :|INITARGS| '#11# :|TYPE| '|COMMON-LISP|::|FIXNUM| :|ALLOCATION|
+ ':|INSTANCE| #15#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| '-1. #12#) #16#
+ '(|COMMON-LISP|::|NIL|) :|READERS| '(|PORT|::|SERVENT-PORT|) :|WRITERS|
+ '((|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PORT|)))
+ (|CLOS|::|MAKE-INSTANCE-<STRUCTURE-DIRECT-SLOT-DEFINITION>|
+ |CLOS|::|<STRUCTURE-DIRECT-SLOT-DEFINITION>| :|NAME| '|PORT|::|PROTO|
+ :|INITARGS| '#13# :|TYPE| '|COMMON-LISP|::|SYMBOL| :|ALLOCATION|
+ ':|INSTANCE| #15#
+ (|CLOS|::|MAKE-INHERITABLE-SLOT-DEFINITION-INITER| ':|TCP| #14#) #16#
+ '(|COMMON-LISP|::|NIL|) :|READERS| '(|PORT|::|SERVENT-PROTO|) :|WRITERS|
+ '((|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PROTO|)))))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|MAKE-SERVENT|
+ (|COMMON-LISP|::|&KEY| (#17=#:|NAME| #4#)
+ (#18=#:|ALIASES| |COMMON-LISP|::|NIL|) (#19=#:|PORT| -1.)
+ (#20=#:|PROTO| :|TCP|))
+ (|COMMON-LISP|::|LET|
+ ((|SYSTEM|::|OBJECT| (|SYSTEM|::|%MAKE-STRUCTURE| #1# 5.)))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 1.)
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING| #17#))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 2.)
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST| #18#))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 3.)
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM| #19#))
+ (|COMMON-LISP|::|SETF|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 4.)
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SYMBOL| #20#))
+ |SYSTEM|::|OBJECT|)))
+ (|COMMON-LISP|::|PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-P|))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|SERVENT-P| (|SYSTEM|::|OBJECT|)
+ (|SYSTEM|::|%STRUCTURE-TYPE-P| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT|))
+ (|COMMON-LISP|::|PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|COPY-SERVENT|))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|COPY-SERVENT| (|COMMON-LISP|::|STRUCTURE|)
+ (|COMMON-LISP|::|COPY-STRUCTURE| |COMMON-LISP|::|STRUCTURE|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|SERVENT-NAME| (|PORT|::|SERVENT|)
+ |COMMON-LISP|::|SIMPLE-STRING|))
+ (|COMMON-LISP|::|PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-NAME|))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|SERVENT-NAME| #21=(|SYSTEM|::|OBJECT|)
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 1.)))
+ (|SYSTEM|::|%PUT| '|PORT|::|SERVENT-NAME| #22='|SYSTEM|::|DEFSTRUCT-READER|
+ '|PORT|::|SERVENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|SERVENT-ALIASES| (|PORT|::|SERVENT|)
+ |COMMON-LISP|::|LIST|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-ALIASES|))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|SERVENT-ALIASES| #21#
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 2.)))
+ (|SYSTEM|::|%PUT| '|PORT|::|SERVENT-ALIASES| #22# '|PORT|::|SERVENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|SERVENT-PORT| (|PORT|::|SERVENT|)
+ |COMMON-LISP|::|FIXNUM|))
+ (|COMMON-LISP|::|PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-PORT|))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|SERVENT-PORT| #21#
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 3.)))
+ (|SYSTEM|::|%PUT| '|PORT|::|SERVENT-PORT| #22# '|PORT|::|SERVENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|SERVENT-PROTO| (|PORT|::|SERVENT|)
+ |COMMON-LISP|::|SYMBOL|))
+ (|COMMON-LISP|::|PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-PROTO|))
+ (|COMMON-LISP|::|DEFUN| |PORT|::|SERVENT-PROTO| #21#
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SYMBOL|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 4.)))
+ (|SYSTEM|::|%PUT| '|PORT|::|SERVENT-PROTO| #22# '|PORT|::|SERVENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-NAME|)
+ (|COMMON-LISP|::|SIMPLE-STRING| |PORT|::|SERVENT|)
+ |COMMON-LISP|::|SIMPLE-STRING|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-NAME|)))
+ (|COMMON-LISP|::|DEFUN| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-NAME|)
+ #23=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|)
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 1.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING| .
+ #24=(|SYSTEM|::|VALUE|))))
+ (|SYSTEM|::|%PUT| '|PORT|::|SERVENT-NAME| #25='|SYSTEM|::|DEFSTRUCT-WRITER|
+ '|PORT|::|SERVENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-ALIASES|)
+ (|COMMON-LISP|::|LIST| |PORT|::|SERVENT|) |COMMON-LISP|::|LIST|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-ALIASES|)))
+ (|COMMON-LISP|::|DEFUN| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-ALIASES|) #23#
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 2.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST| . #24#)))
+ (|SYSTEM|::|%PUT| '|PORT|::|SERVENT-ALIASES| #25# '|PORT|::|SERVENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PORT|)
+ (|COMMON-LISP|::|FIXNUM| |PORT|::|SERVENT|) |COMMON-LISP|::|FIXNUM|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PORT|)))
+ (|COMMON-LISP|::|DEFUN| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PORT|) #23#
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 3.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM| . #24#)))
+ (|SYSTEM|::|%PUT| '|PORT|::|SERVENT-PORT| #25# '|PORT|::|SERVENT|)
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PROTO|)
+ (|COMMON-LISP|::|SYMBOL| |PORT|::|SERVENT|) |COMMON-LISP|::|SYMBOL|))
+ (|COMMON-LISP|::|PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PROTO|)))
+ (|COMMON-LISP|::|DEFUN| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PROTO|) #23#
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 4.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SYMBOL| . #24#)))
+ (|SYSTEM|::|%PUT| '|PORT|::|SERVENT-PROTO| #25# '|PORT|::|SERVENT|)
+ (|SYSTEM|::|%SET-DOCUMENTATION| '|PORT|::|SERVENT| '|COMMON-LISP|::|TYPE|
+ "see getservbyname(3) for details")
+ (|CLOS|::|DEFSTRUCT-REMOVE-PRINT-OBJECT-METHOD| '|PORT|::|SERVENT|)
+ '|PORT|::|SERVENT|)
+(|SYSTEM|::|C-DEFUN| '|PORT|::|MAKE-SERVENT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|&KEY| (#:|NAME| "") (#:|ALIASES| |COMMON-LISP|::|NIL|)
+ (#:|PORT| -1.) (#:|PROTO| :|TCP|))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-P|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|SERVENT-P|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|SERVENT-P|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-P|
+ (|SYSTEM|::|%STRUCTURE-TYPE-P| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT|))))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|COPY-SERVENT|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|COPY-SERVENT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|COMMON-LISP|::|STRUCTURE|))
+ '(#1# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|COPY-SERVENT|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|COPY-SERVENT|
+ (|COMMON-LISP|::|COPY-STRUCTURE| |COMMON-LISP|::|STRUCTURE|))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|SERVENT-NAME| (|PORT|::|SERVENT|)
+ |COMMON-LISP|::|SIMPLE-STRING|))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-NAME|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|SERVENT-NAME|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|SERVENT-NAME|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-NAME|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 1.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|SERVENT-ALIASES| (|PORT|::|SERVENT|)
+ |COMMON-LISP|::|LIST|))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-ALIASES|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|SERVENT-ALIASES|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|SERVENT-ALIASES|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-ALIASES|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 2.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|SERVENT-PORT| (|PORT|::|SERVENT|)
+ |COMMON-LISP|::|FIXNUM|))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-PORT|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|SERVENT-PORT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|SERVENT-PORT|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-PORT|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 3.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| |PORT|::|SERVENT-PROTO| (|PORT|::|SERVENT|)
+ |COMMON-LISP|::|SYMBOL|))
+(|SYSTEM|::|C-PROCLAIM| '(|COMMON-LISP|::|INLINE| |PORT|::|SERVENT-PROTO|))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|SERVENT-PROTO|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE| '#1=(|SYSTEM|::|OBJECT|))
+ '(#1#
+ (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| |PORT|::|SERVENT-PROTO|))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-PROTO|
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SYMBOL|
+ (|SYSTEM|::|%STRUCTURE-REF| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 4.)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-NAME|)
+ (|COMMON-LISP|::|SIMPLE-STRING| |PORT|::|SERVENT|)
+ |COMMON-LISP|::|SIMPLE-STRING|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-NAME|)))
+(|SYSTEM|::|C-DEFUN| '#1=(|COMMON-LISP|::|SETF| |PORT|::|SERVENT-NAME|)
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#2=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|))
+ '(#2# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| #1#))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-NAME|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 1.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SIMPLE-STRING|
+ |SYSTEM|::|VALUE|)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-ALIASES|)
+ (|COMMON-LISP|::|LIST| |PORT|::|SERVENT|) |COMMON-LISP|::|LIST|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-ALIASES|)))
+(|SYSTEM|::|C-DEFUN| '#1=(|COMMON-LISP|::|SETF| |PORT|::|SERVENT-ALIASES|)
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#2=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|))
+ '(#2# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| #1#))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-ALIASES|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 2.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|LIST| |SYSTEM|::|VALUE|)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PORT|)
+ (|COMMON-LISP|::|FIXNUM| |PORT|::|SERVENT|) |COMMON-LISP|::|FIXNUM|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PORT|)))
+(|SYSTEM|::|C-DEFUN| '#1=(|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PORT|)
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#2=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|))
+ '(#2# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| #1#))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-PORT|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 3.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|FIXNUM| |SYSTEM|::|VALUE|)))))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|FUNCTION| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PROTO|)
+ (|COMMON-LISP|::|SYMBOL| |PORT|::|SERVENT|) |COMMON-LISP|::|SYMBOL|))
+(|SYSTEM|::|C-PROCLAIM|
+ '(|COMMON-LISP|::|INLINE| (|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PROTO|)))
+(|SYSTEM|::|C-DEFUN| '#1=(|COMMON-LISP|::|SETF| |PORT|::|SERVENT-PROTO|)
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '#2=(|SYSTEM|::|VALUE| |SYSTEM|::|OBJECT|))
+ '(#2# (|COMMON-LISP|::|DECLARE| (|SYSTEM|::|IN-DEFUN| #1#))
+ (|COMMON-LISP|::|BLOCK| |PORT|::|SERVENT-PROTO|
+ (|SYSTEM|::|%STRUCTURE-STORE| '|PORT|::|SERVENT| |SYSTEM|::|OBJECT| 4.
+ (|COMMON-LISP|::|THE| |COMMON-LISP|::|SYMBOL| |SYSTEM|::|VALUE|)))))
+(|SYSTEM|::|C-DEFUN| '|PORT|::|SOCKET-SERVICE-PORT|
+ (|SYSTEM|::|LAMBDA-LIST-TO-SIGNATURE|
+ '(|COMMON-LISP|::|&OPTIONAL| |PORT|::|SERVICE| (|PORT|::|PROTOCOL| "tcp"))))
+(|SYSTEM|::|C-PROVIDE| ':|PORT-NET|)
Added: clfswm/contrib/server/net.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/net.lisp Thu Aug 12 17:30:52 2010
@@ -0,0 +1,781 @@
+;;; Network Access
+;;;
+;;; Copyright (C) 1999-2008 by Sam Steingold
+;;; This is open-source software.
+;;; GNU Lesser General Public License (LGPL) is applicable:
+;;; No warranty; you may copy/modify/redistribute under the same
+;;; conditions with the source code.
+;;; See <URL:http://www.gnu.org/copyleft/lesser.html>
+;;; for details and the precise copyright document.
+;;;
+;;; $Id: net.lisp,v 1.64 2008/10/20 19:54:38 sds Exp $
+;;; $Source: /cvsroot-fuse/clocc/clocc/src/port/net.lisp,v $
+
+(in-package :cl-user)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;;(require "ext.lisp")
+ ;; `getenv'
+ ;;(require "sys.lisp")
+ #+(or cmu scl) (require :simple-streams) ; for `set-socket-stream-format'
+ #+cormanlisp (require :winsock)
+ #+lispworks (require "comm")
+ #+(and sbcl (not (or db-sockets net.sbcl.sockets)))
+ (progn (require :sb-bsd-sockets) (pushnew :sb-bsd-sockets *features*)))
+
+(defpackage :port
+ (:use :common-lisp)
+ (:export :resolve-host-ipaddr
+ :ipaddr-to-dotted
+ :dotted-to-ipaddr
+ :ipaddr-closure
+ :hostent
+ :hostent-name
+ :hostent-aliases
+ :hostent-addr-list
+ :hostent-addr-type
+ :socket
+ :open-socket
+ :socket-host/port
+ :socket-string
+ :socket-server
+ :set-socket-stream-format
+ :socket-accept
+ :open-socket-server
+ :socket-server-close
+ :socket-server-host/port
+ :socket-service-port
+ :servent-name
+ :servent-aliases
+ :servent-port
+ :servent-proto
+ :servent-p
+ :servent
+ :network
+ :timeout
+ :login
+ :net-path))
+
+(in-package :port)
+
+
+(define-condition code (error)
+ ((proc :reader code-proc :initarg :proc :initform nil)
+ (mesg :type (or null simple-string) :reader code-mesg
+ :initarg :mesg :initform nil)
+ (args :type list :reader code-args :initarg :args :initform nil))
+ (:documentation "An error in the user code.")
+ (:report (lambda (cc out)
+ (declare (stream out))
+ (format out "[~s]~@[ ~?~]" (code-proc cc) (code-mesg cc)
+ (code-args cc)))))
+
+(define-condition case-error (code)
+ ((mesg :type simple-string :reader code-mesg :initform
+ "`~s' evaluated to `~s', not one of [~@{`~s'~^ ~}]"))
+ (:documentation "An error in a case statement.
+This carries the function name which makes the error message more useful."))
+
+
+(define-condition not-implemented (code)
+ ((mesg :type simple-string :reader code-mesg :initform
+ "not implemented for ~a [~a]")
+ (args :type list :reader code-args :initform
+ (list (lisp-implementation-type) (lisp-implementation-version))))
+ (:documentation "Your implementation does not support this functionality."))
+
+
+(defmacro with-gensyms ((title &rest names) &body body)
+ "Bind symbols in NAMES to gensyms. TITLE is a string - `gensym' prefix.
+Inspired by Paul Graham, <On Lisp>, p. 145."
+ `(let (,@(mapcar (lambda (sy)
+ `(,sy (gensym ,(concatenate 'string title
+ (symbol-name sy) "-"))))
+ names))
+ , at body))
+
+(defmacro defconst (name type init doc)
+ "Define a typed constant."
+ `(progn (declaim (type ,type ,name))
+ ;; since constant redefinition must be the same under EQL, there
+ ;; can be no constants other than symbols, numbers and characters
+ ;; see ANSI CL spec 3.1.2.1.1.3 "Constant Variables"
+ (,(if (subtypep type '(or symbol number character)) 'defconstant 'defvar)
+ ,name (the ,type ,init) ,doc)))
+
+(defconst +eof+ cons (list '+eof+)
+ "*The end-of-file object.
+To be passed as the third arg to `read' and checked against using `eq'.")
+
+(defun string-tokens (string &key (start 0) end max
+ ((:package *package*) (find-package :keyword)))
+ "Read from STRING repeatedly, starting with START, up to MAX tokens.
+Return the list of objects read and the final index in STRING.
+Binds `*package*' to the KEYWORD package (or argument),
+so that the bare symbols are read as keywords."
+ (declare (type (or null fixnum) max) (type fixnum start))
+ (if max
+ (do ((beg start) obj res (num 0 (1+ num)))
+ ((or (= max num) (and end (>= beg end)))
+ (values (nreverse res) beg))
+ (declare (fixnum beg num))
+ (setf (values obj beg)
+ (read-from-string string nil +eof+ :start beg :end end))
+ (if (eq obj +eof+)
+ (return (values (nreverse res) beg))
+ (push obj res)))
+ (with-input-from-string (st string :start start :end end)
+ (loop :for obj = (read st nil st)
+ :until (eq obj st) :collect obj))))
+
+
+
+(defmacro compose (&rest functions)
+ "Macro: compose functions or macros of 1 argument into a lambda.
+E.g., (compose abs (dl-val zz) 'key) ==>
+ (lambda (yy) (abs (funcall (dl-val zz) (funcall key yy))))"
+ (labels ((rec (xx yy)
+ (let ((rr (list (car xx) (if (cdr xx) (rec (cdr xx) yy) yy))))
+ (if (consp (car xx))
+ (cons 'funcall (if (eq (caar xx) 'quote)
+ (cons (cadar xx) (cdr rr)) rr))
+ rr))))
+ (with-gensyms ("COMPOSE-" arg)
+ `(lambda (,arg) ,(rec functions arg)))))
+
+
+
+
+;;;
+;;; {{{ name resolution
+;;;
+
+(declaim (ftype (function ((unsigned-byte 32)) (values simple-string))
+ ipaddr-to-dotted))
+(defun ipaddr-to-dotted (ipaddr)
+ "Number --> string."
+ (declare (type (unsigned-byte 32) ipaddr))
+ #+allegro (socket:ipaddr-to-dotted ipaddr)
+ #+(or openmcl ccl) (ccl:ipaddr-to-dotted ipaddr)
+ #+(and sbcl net.sbcl.sockets) (net.sbcl.sockets:ipaddr-to-dot-string ipaddr)
+ #-(or allegro openmcl ccl (and sbcl net.sbcl.sockets))
+ (format nil "~d.~d.~d.~d"
+ (logand #xff (ash ipaddr -24)) (logand #xff (ash ipaddr -16))
+ (logand #xff (ash ipaddr -8)) (logand #xff ipaddr)))
+
+(declaim (ftype (function (string) (values (unsigned-byte 32)))
+ dotted-to-ipaddr))
+(defun dotted-to-ipaddr (dotted)
+ "String --> number."
+ (declare (string dotted))
+ #+allegro (socket:dotted-to-ipaddr dotted)
+ #+(or openmcl ccl) (ccl:dotted-to-ipaddr dotted)
+ #+(and sbcl net.sbcl.sockets) (net.sbcl.sockets:dot-string-to-ipaddr dotted)
+ #-(or allegro openmcl ccl (and sbcl net.sbcl.sockets))
+ (let ((ll (string-tokens (substitute #\Space #\. dotted))))
+ (+ (ash (first ll) 24) (ash (second ll) 16)
+ (ash (third ll) 8) (fourth ll))))
+
+;#+(and sbcl (or db-sockets sb-bsd-sockets))
+;(declaim (ftype (function (vector) (values (unsigned-byte 32)))
+; vector-to-ipaddr))
+#+(and sbcl (or db-sockets sb-bsd-sockets))
+(defun vector-to-ipaddr (vector)
+ (+ (ash (aref vector 0) 24)
+ (ash (aref vector 1) 16)
+ (ash (aref vector 2) 8)
+ (aref vector 3)))
+
+;#+(and sbcl (or db-sockets sb-bsd-sockets))
+;(declaim (ftype (function (vector) (values (unsigned-byte 32)))
+; ipaddr-to-vector))
+#+(and sbcl (or db-sockets sb-bsd-sockets))
+(defun ipaddr-to-vector (ipaddr)
+ (vector (ldb (byte 8 24) ipaddr)
+ (ldb (byte 8 16) ipaddr)
+ (ldb (byte 8 8) ipaddr)
+ (ldb (byte 8 0) ipaddr)))
+
+(defstruct hostent
+ "see gethostbyname(3) for details"
+ (name "" :type simple-string) ; canonical name of host
+ (aliases nil :type list) ; alias list
+ (addr-list nil :type list) ; list of addresses
+ (addr-type 2 :type fixnum)) ; host address type
+
+(defun resolve-host-ipaddr (host)
+ "Call gethostbyname(3) or gethostbyaddr(3)."
+ #+allegro
+ (let* ((ipaddr
+ (etypecase host
+ (string
+ (if (every (lambda (ch) (or (char= ch #\.) (digit-char-p ch)))
+ host)
+ (socket:dotted-to-ipaddr host)
+ (socket:lookup-hostname host)))
+ (integer host)))
+ (name (socket:ipaddr-to-hostname ipaddr)))
+ (make-hostent :name name :addr-list
+ (list (socket:ipaddr-to-dotted ipaddr))))
+ #+(and clisp syscalls)
+ (let ((he (posix:resolve-host-ipaddr host)))
+ (make-hostent :name (posix::hostent-name he)
+ :aliases (posix::hostent-aliases he)
+ :addr-list (posix::hostent-addr-list he)
+ :addr-type (posix::hostent-addrtype he)))
+ #+(or cmu scl)
+ (let ((he (ext:lookup-host-entry host)))
+ (make-hostent :name (ext:host-entry-name he)
+ :aliases (ext:host-entry-aliases he)
+ :addr-list (mapcar #'ipaddr-to-dotted
+ (ext:host-entry-addr-list he))
+ :addr-type (ext::host-entry-addr-type he)))
+ #+gcl (make-hostent :name (or (si:hostid-to-hostname host) host)
+ :addr-list (list (si:hostname-to-hostid host)))
+ #+lispworks
+ (multiple-value-bind (name addr aliases)
+ (comm:get-host-entry host :fields '(:name :address :aliases))
+ (make-hostent :name name :addr-list (list (ipaddr-to-dotted addr))
+ :aliases aliases))
+ #+(or openmcl ccl)
+ (let* ((ipaddr
+ (etypecase host
+ (string
+ (if (every (lambda (ch) (or (char= ch #\.) (digit-char-p ch)))
+ host)
+ (dotted-to-ipaddr host)
+ (ccl:lookup-hostname host)))
+ (integer host)))
+ (name (ccl:ipaddr-to-hostname ipaddr)))
+ (make-hostent :name name :addr-list (list (ccl:lookup-hostname ipaddr))))
+ #+(and sbcl sb-bsd-sockets)
+ (let ((he (sb-bsd-sockets:get-host-by-name host)))
+ (make-hostent :name (sb-bsd-sockets:host-ent-name he)
+ :addr-list
+ (loop for ipaddr in (sb-bsd-sockets:host-ent-addresses he)
+ collect (format nil "~{~a~^.~}"
+ (loop for octect
+ being the elements of ipaddr
+ collect octect)))))
+ #+(and sbcl db-sockets)
+ (let* ((ipaddr
+ (etypecase host
+ (string
+ (if (every (lambda (ch) (or (char= ch #\.) (digit-char-p ch)))
+ host)
+ (dotted-to-ipaddr host)
+ (let ((hostent
+ (sockets:get-host-by-name host)))
+ (when hostent
+ (vector-to-ipaddr
+ (sockets::host-ent-address hostent))))))
+ (integer host)))
+ (name
+ (when ipaddr
+ (let ((hostent
+ (sockets:get-host-by-address
+ (ipaddr-to-vector ipaddr))))
+ (when (and hostent
+ (sockets::host-ent-aliases hostent))
+ (first (sockets::host-ent-aliases hostent)))))))
+ (make-hostent :name name :addr-list (list ipaddr)))
+ #+(and sbcl net.sbcl.sockets)
+ (let ((he (net.sbcl.sockets:lookup-host-entry host)))
+ (make-hostent :name (net.sbcl.sockets:host-entry-name he)
+ :aliases (net.sbcl.sockets:host-entry-aliases he)
+ :addr-list (mapcar #'ipaddr-to-dotted
+ (net.sbcl.sockets:host-entry-addr-list he))
+ :addr-type (net.sbcl.sockets::host-entry-addr-type he)))
+ #-(or allegro (and clisp syscalls) cmu gcl lispworks openmcl ccl
+ (and sbcl (or db-sockets net.sbcl.sockets sb-bsd-sockets)) scl)
+ (error 'not-implemented :proc (list 'resolve-host-ipaddr host)))
+
+(defun ipaddr-closure (address)
+ "Resolve all addresses and names associated with the argument."
+ (let ((a2he (make-hash-table :test 'equalp))
+ (he2a (make-hash-table :test 'equalp)))
+ (labels ((handle (s)
+ (unless (gethash s a2he)
+ (let ((he (resolve-host-ipaddr s)))
+ (setf (gethash s a2he) he)
+ (push s (gethash he he2a))
+ (handle (hostent-name he))
+ (mapc #'handle (hostent-aliases he))
+ (mapc #'handle (hostent-addr-list he))))))
+ (handle address))
+ (values he2a a2he)))
+
+;;;
+;;; }}}{{{ sockets
+;;;
+
+(deftype socket ()
+ #+abcl 'to-way-stream
+ #+allegro 'excl::socket-stream
+ #+clisp 'stream
+ #+(or cmu scl) 'stream ; '(or stream:socket-simple-stream sys:fd-stream)
+ #+gcl 'stream
+ #+lispworks 'comm:socket-stream
+ #+(or openmcl ccl) 'ccl::socket
+ #+(and sbcl (or db-sockets sb-bsd-sockets)) 'sb-sys:fd-stream
+ #+(and sbcl net.sbcl.sockets) 'net.sbcl.sockets:stream-socket
+ #-(or abcl allegro clisp cmu gcl lispworks openmcl ccl
+ (and sbcl (or db-sockets net.sbcl.sockets sb-bsd-sockets)) scl) 'stream)
+
+(defun open-socket (host port &optional bin)
+ "Open a socket connection to HOST at PORT."
+ (declare (type (or integer string) host) (fixnum port)
+ #+(or cmu scl) (ignore bin))
+ (let ((host (etypecase host
+ (string host)
+ (integer (hostent-name (resolve-host-ipaddr host))))))
+ #+abcl (ext:get-socket-stream
+ (sys:make-socket host port)
+ :element-type (if bin '(unsigned-byte 8) 'character))
+ #+allegro (socket:make-socket :remote-host host :remote-port port
+ :format (if bin :binary :text))
+ #+clisp (#+lisp=cl ext:socket-connect #-lisp=cl lisp:socket-connect
+ port host :element-type
+ (if bin '(unsigned-byte 8) 'character))
+ #+(or cmu scl)
+ (make-instance 'stream:socket-simple-stream :direction :io
+ :remote-host host :remote-port port)
+ #+gcl (si:socket port :host host)
+ #+lispworks (comm:open-tcp-stream host port :direction :io :element-type
+ (if bin 'unsigned-byte 'base-char))
+ #+(or mcl ccl) (ccl:make-socket :remote-host host :remote-port port
+ :format (if bin :binary :text))
+ #+(and sbcl db-sockets)
+ (let ((socket (make-instance 'sockets:inet-socket
+ :type :stream :protocol :tcp)))
+ (sockets:socket-connect socket
+ (sockets::host-ent-address
+ (sockets:get-host-by-name host))
+ port)
+ (sockets:socket-make-stream
+ socket :input t :output t :buffering (if bin :none :line)
+ :element-type (if bin '(unsigned-byte 8) 'character)))
+ #+(and sbcl net.sbcl.sockets)
+ (net.sbcl.sockets:make-socket
+ (if bin
+ 'net.sbcl.sockets:binary-stream-socket
+ 'net.sbcl.sockets:character-stream-socket)
+ :port port :host host)
+ #+(and sbcl sb-bsd-sockets)
+ (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+ :type :stream :protocol :tcp)))
+ (sb-bsd-sockets:socket-connect socket
+ (sb-bsd-sockets::host-ent-address
+ (sb-bsd-sockets:get-host-by-name host))
+ port)
+ (sb-bsd-sockets:socket-make-stream
+ socket :input t :output t :buffering (if bin :none :line)
+ :element-type (if bin '(unsigned-byte 8) 'character)))
+ #-(or abcl allegro clisp cmu gcl lispworks mcl ccl
+ (and sbcl (or net.sbcl.sockets db-sockets sb-bsd-sockets)) scl)
+ (error 'not-implemented :proc (list 'open-socket host port bin))))
+
+(defun set-socket-stream-format (socket format)
+ "switch between binary and text output"
+ #+clisp (setf (stream-element-type socket) format)
+ #+(or acl cmu lispworks scl)
+ (declare (ignore socket format)) ; bivalent streams
+ #-(or acl clisp cmu lispworks scl)
+ (error 'not-implemented :proc (list 'set-socket-stream-format socket format)))
+
+#+(and sbcl sb-bsd-sockets)
+(defun funcall-on-sock (function sock)
+ "Apply function (getsockname/getpeername) on socket, return host/port as two values"
+ (let ((sockaddr (sockint::allocate-sockaddr-in)))
+ (funcall function (sb-sys:fd-stream-fd sock) sockaddr sockint::size-of-sockaddr-in)
+ (let ((host (coerce (loop :for i :from 0 :below 4
+ :collect (sb-alien:deref (sockint::sockaddr-in-addr sockaddr) i))
+ '(vector (unsigned-byte 8) 4)))
+ (port (+ (* 256 (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 0))
+ (sb-alien:deref (sockint::sockaddr-in-port sockaddr) 1))))
+ (sockint::free-sockaddr-in sockaddr)
+ (values host port))))
+
+(defun socket-host/port (sock)
+ "Return the remote and local host&port, as 4 values."
+ (declare (type socket sock))
+ #+allegro (values (socket:ipaddr-to-dotted (socket:remote-host sock))
+ (socket:remote-port sock)
+ (socket:ipaddr-to-dotted (socket:local-host sock))
+ (socket:local-port sock))
+ #+clisp (flet ((ip (ho) (subseq ho 0 (position #\Space ho :test #'char=))))
+ (multiple-value-bind (ho1 po1)
+ (#+lisp=cl ext:socket-stream-peer
+ #-lisp=cl lisp:socket-stream-peer sock)
+ (multiple-value-bind (ho2 po2)
+ (#+lisp=cl ext:socket-stream-local
+ #-lisp=cl lisp:socket-stream-local sock)
+ (values (ip ho1) po1
+ (ip ho2) po2))))
+ #+(or cmu scl)
+ (let ((fd (sys:fd-stream-fd sock)))
+ (multiple-value-bind (ho1 po1) (ext:get-peer-host-and-port fd)
+ (multiple-value-bind (ho2 po2) (ext:get-socket-host-and-port fd)
+ (values (ipaddr-to-dotted ho1) po1
+ (ipaddr-to-dotted ho2) po2))))
+ #+gcl (let ((peer (si:getpeername sock))
+ (loc (si:getsockname sock)))
+ (values (car peer) (caddr peer)
+ (car loc) (caddr loc)))
+ #+lispworks
+ (multiple-value-bind (ho1 po1) (comm:socket-stream-peer-address sock)
+ (multiple-value-bind (ho2 po2) (comm:socket-stream-address sock)
+ (values (ipaddr-to-dotted ho1) po1
+ (ipaddr-to-dotted ho2) po2)))
+ #+(or mcl ccl)
+ (values (ccl:ipaddr-to-dotted (ccl:remote-host sock))
+ (ccl:remote-port sock)
+ (ccl:ipaddr-to-dotted (ccl:local-host sock))
+ (ccl:local-port sock))
+ #+(and sbcl db-sockets)
+ (let ((sock (sb-sys:fd-stream-fd sock)))
+ (multiple-value-bind (remote remote-port) (sockets:socket-peername sock)
+ (multiple-value-bind (local local-port) (sockets:socket-name sock)
+ (values (ipaddr-to-dotted (vector-to-ipaddr remote))
+ remote-port
+ (ipaddr-to-dotted (vector-to-ipaddr local))
+ local-port))))
+ #+(and sbcl net.sbcl.sockets)
+ (net.sbcl.sockets:socket-host-port sock)
+ #+(and sbcl sb-bsd-sockets)
+ (multiple-value-bind (remote remote-port)
+ (funcall-on-sock #'sockint::getpeername sock)
+ (multiple-value-bind (local local-port)
+ (funcall-on-sock #'sockint::getsockname sock)
+ (values (ipaddr-to-dotted (vector-to-ipaddr remote))
+ remote-port
+ (ipaddr-to-dotted (vector-to-ipaddr local))
+ local-port)))
+ #-(or allegro clisp cmu gcl lispworks mcl ccl
+ (and sbcl (or net.sbcl.sockets db-sockets sb-bsd-sockets)) scl)
+ (error 'not-implemented :proc (list 'socket-host/port sock)))
+
+(defun socket-string (sock)
+ "Print the socket local&peer host&port to a string."
+ (declare (type socket sock))
+ (with-output-to-string (stream)
+ (print-unreadable-object (sock stream :type t :identity t)
+ (multiple-value-bind (ho1 po1 ho2 po2) (socket-host/port sock)
+ (format stream "[local: ~a:~d] [peer: ~s:~d]" ho2 po2 ho1 po1)))))
+
+;;;
+;;; }}}{{{ socket-servers
+;;;
+
+#+lispworks (defstruct socket-server proc mbox port)
+#-lispworks
+(deftype socket-server ()
+ #+abcl 'ext:javaobject
+ #+allegro 'acl-socket::socket-stream-internet-passive
+ #+(and clisp lisp=cl) 'ext:socket-server
+ #+(and clisp (not lisp=cl)) 'lisp:socket-server
+ #+(or cmu scl) 'integer
+ #+gcl 'si:socket-stream
+ #+(or mcl ccl) 'ccl::listener-socket
+ #+(and sbcl db-sockets) 'sb-sys:fd-stream
+ #+(and sbcl net.sbcl.sockets) 'net.sbcl.sockets:passive-socket
+ #+(and sbcl sb-bsd-sockets) 'sb-bsd-sockets:inet-socket
+ #-(or abcl allegro clisp cmu gcl mcl ccl
+ (and sbcl (or net.sbcl.sockets db-sockets)) scl) t)
+
+(defun open-socket-server (&optional port)
+ "Open a `generic' socket server."
+ (declare (type (or null integer #-sbcl socket) port))
+ #+abcl (ext:make-server-socket port)
+ #+allegro (socket:make-socket :connect :passive :local-port
+ (when (integerp port) port))
+ #+clisp (#+lisp=cl ext:socket-server #-lisp=cl lisp:socket-server port)
+ #+(or cmu scl) (ext:create-inet-listener (or port 0) :stream :reuse-address t)
+ #+gcl (si:make-socket-pair port) ; FIXME
+ #+lispworks (let ((mbox (mp:make-mailbox :size 1)))
+ (make-socket-server
+ :mbox mbox :port port
+ :proc (comm:start-up-server
+ :function (lambda (sock) (mp:mailbox-send mbox sock))
+ :service port)))
+ #+(or mcl ccl)
+ (ccl:make-socket :connect :passive
+ :type :stream
+ :reuse-address t
+ :local-port (or port 0))
+ #+(and sbcl db-sockets)
+ (let ((socket (make-instance 'sockets:inet-socket
+ :type :stream :protocol :tcp)))
+ (sockets:socket-bind socket (vector 0 0 0 0) (or port 0)))
+ #+(and sbcl net.sbcl.sockets)
+ (net.sbcl.sockets:make-socket 'net.sbcl.sockets:passive-socket :port port)
+ #+(and sbcl sb-bsd-sockets)
+ (let ((sock (make-instance 'sb-bsd-sockets:inet-socket
+ :type :stream
+ :protocol :tcp)))
+ (setf (sb-bsd-sockets:sockopt-reuse-address sock) t)
+ (sb-bsd-sockets:socket-bind sock (vector 0 0 0 0) (or port 0))
+ (sb-bsd-sockets:socket-listen sock 15)
+ sock)
+ #-(or abcl allegro clisp cmu gcl lispworks mcl ccl
+ (and sbcl (or net.sbcl.sockets db-sockets sb-bsd-sockets)) scl)
+ (error 'not-implemented :proc (list 'open-socket-server port)))
+
+(defun socket-accept (serv &key bin wait)
+ "Accept a connection on a socket server (passive socket).
+Keyword arguments are:
+ BIN - create a binary stream;
+ WAIT - wait for the connection this many seconds
+ (the default is NIL - wait forever).
+Returns a socket stream or NIL."
+ (declare (type socket-server serv)
+ #+(or (and allegro (version>= 6)) openmcl ccl)
+ (ignore bin))
+ #+abcl (ext:get-socket-stream
+ (ext:socket-accept serv)
+ :element-type (if bin '(unsigned-byte 8) 'character))
+ #+allegro (let* ((fmt (if bin :binary :text))
+ #+allegro-v5.0
+ (excl:*default-external-format* fmt)
+ (sock (if wait
+ (if (plusp wait)
+ (mp:with-timeout (wait)
+ (socket:accept-connection serv :wait t))
+ (socket:accept-connection serv :wait nil))
+ (socket:accept-connection serv :wait t))))
+ (when sock
+ ;; From: John Foderaro <jkf at franz.com>
+ ;; Date: Sun, 12 Nov 2000 16:58:28 -0800
+ ;; in ACL6 and later, all sockets are bivalent (both
+ ;; text and binary) and thus there's no need to convert
+ ;; between the element types.
+ #+allegro-v5.0
+ (unless (eq (socket:socket-format sock) fmt)
+ (warn "~s: ACL5 cannot modify socket format"
+ 'socket-accept))
+ #+allegro-v4.3
+ (socket:set-socket-format sock fmt)
+ sock))
+ #+clisp (multiple-value-bind (sec usec) (floor (or wait 0))
+ (when (#+lisp=cl ext:socket-wait #-lisp=cl lisp:socket-wait
+ serv (and wait sec) (round usec 1d-6))
+ (#+lisp=cl ext:socket-accept #-lisp=cl lisp:socket-accept
+ serv :element-type
+ (if bin '(unsigned-byte 8) 'character))))
+ #+(or cmu scl)
+ (when (sys:wait-until-fd-usable serv :input wait)
+ (sys:make-fd-stream (ext:accept-tcp-connection serv)
+ :buffering (if bin :full :line)
+ :input t :output t :element-type
+ (if bin '(unsigned-byte 8) 'character)))
+ #+gcl (si:accept-socket-connection serv bin wait) ; FIXME
+ #+lispworks (make-instance
+ 'comm:socket-stream :direction :io
+ :socket (mp:mailbox-read (socket-server-mbox serv))
+ :element-type (if bin 'unsigned-byte 'base-char))
+ ;; For ccl, as wait is a boolean, the time to wait is ignored.
+ #+(or mcl ccl) (ccl:accept-connection serv :wait (not wait))
+ #+(and sbcl db-sockets)
+ (let ((new-connection (sockets:socket-accept serv)))
+ ;; who needs WAIT and BIN anyway :-S
+ new-connection)
+ #+(and sbcl net.sbcl.sockets)
+ (net.sbcl.sockets:accept-connection
+ serv
+ (if bin
+ 'net.sbcl.sockets:binary-stream-socket
+ 'net.sbcl.sockets:character-stream-socket)
+ :wait wait)
+ #+(and sbcl sb-bsd-sockets)
+ (progn
+ (setf (sb-bsd-sockets:non-blocking-mode serv) wait)
+ (let ((s (sb-bsd-sockets:socket-accept serv)))
+ (if s
+ (sb-bsd-sockets:socket-make-stream
+ s :input t :output t
+ :element-type (if bin '(unsigned-byte 8) 'character)
+ :buffering (if bin :full :line))
+ (sleep wait))))
+ #-(or abcl allegro clisp cmu gcl lispworks mcl ccl
+ (and sbcl (or net.sbcl.sockets db-sockets sb-bsd-sockets)) scl)
+ (error 'not-implemented :proc (list 'socket-accept serv bin)))
+
+(defun socket-server-close (server)
+ "Close the server."
+ (declare (type socket-server server))
+ #+abcl (ext:server-socket-close server)
+ #+allegro (close server)
+ #+clisp (#+lisp=cl ext:socket-server-close
+ #-lisp=cl lisp:socket-server-close server)
+ #+(or cmu scl) (unix:unix-close server)
+ #+gcl (close server)
+ #+lispworks (mp:process-kill (socket-server-proc server))
+ #+(or openmcl ccl) (close server)
+ #+(and sbcl db-sockets) (sockets:socket-close server)
+ #+(and sbcl net.sbcl.sockets) (close server)
+ #+(and sbcl sb-bsd-sockets) (sb-bsd-sockets:socket-close server)
+ #-(or abcl allegro clisp cmu gcl lispworks openmcl ccl
+ (and sbcl (or net.sbcl.sockets db-sockets sb-bsd-sockets)) scl)
+ (error 'not-implemented :proc (list 'socket-server-close server)))
+
+(defun socket-server-host/port (server)
+ "Return the local host&port on which the server is running, as 2 values."
+ (declare (type socket-server server))
+ #+allegro (values (socket:ipaddr-to-dotted (socket:local-host server))
+ (socket:local-port server))
+ #+(and clisp lisp=cl) (values (ext:socket-server-host server)
+ (ext:socket-server-port server))
+ #+(and clisp (not lisp=cl)) (values (lisp:socket-server-host server)
+ (lisp:socket-server-port server))
+ #+(or cmu scl)
+ (values (ipaddr-to-dotted (car (ext:host-entry-addr-list
+ (ext:lookup-host-entry "localhost"))))
+ (nth-value 1 (ext:get-socket-host-and-port server)))
+ #+gcl (let ((sock (si:getsockname server)))
+ (values (car sock) (caddr sock)))
+ #+lispworks (values (ipaddr-to-dotted (comm:get-host-entry
+ "localhost" :fields '(:address)))
+ (socket-server-port server))
+ #+(or openmcl ccl)
+ (values (ccl:ipaddr-to-dotted (ccl:local-host server))
+ (ccl:local-port server))
+ #+(and sbcl db-sockets)
+ (multiple-value-bind (addr port) (sockets:socket-name server)
+ (values (vector-to-ipaddr addr) port))
+ #+(and sbcl net.sbcl.sockets)
+ (net.sbcl.sockets:passive-socket-host-port server)
+ #+(and sbcl sb-bsd-sockets)
+ (multiple-value-bind (addr port) (sb-bsd-sockets:socket-name server)
+ (values (ipaddr-to-dotted (vector-to-ipaddr addr)) port))
+ #-(or allegro clisp cmu gcl lispworks openmcl ccl
+ (and sbcl (or net.sbcl.sockets db-sockets sb-bsd-sockets)) scl)
+ (error 'not-implemented :proc (list 'socket-server-host/port server)))
+
+;;;
+;;; }}}{{{ for CLX
+;;;
+
+(defun wait-for-stream (stream &optional timeout)
+ "Sleep until there is input on the STREAM, or for TIMEOUT seconds,
+whichever comes first. If there was a timeout, return NIL."
+ #+clisp (multiple-value-bind (sec usec) (floor (or timeout 0))
+ (#+lisp=cl ext:socket-status #-lisp=cl lisp:socket-status
+ stream (and timeout sec) (round usec 1d-6)))
+ #+(or cmu scl)
+ (#+mp mp:process-wait-until-fd-usable #-mp sys:wait-until-fd-usable
+ (system:fd-stream-fd stream) :input timeout)
+ #+(or openmcl ccl)
+ (ccl:make-socket :type :stream
+ :address-family :file
+ :connect :active
+ :format :text ;;(if bin :binary :text)
+ :remote-filename #P"");;path)
+ #+(and sbcl net.sbcl.sockets)
+ (net.sbcl.sockets:wait-for-input-data stream timeout)
+ #+(and sbcl db-sockets)
+ (sb-sys:wait-until-fd-usable (sb-sys:fd-stream-fd stream) :input timeout)
+ #-(or clisp cmu (and sbcl (or net.sbcl.sockets db-sockets)) scl)
+ (error 'not-implemented :proc (list 'wait-for-stream stream timeout)))
+
+(defun open-unix-socket (path &key (kind :stream) bin)
+ "Opens a unix socket. Path is the location.
+Kind can be :stream or :datagram."
+ (declare (simple-string path) #-(or cmu sbcl) (ignore kind))
+ #+allegro (socket:make-socket :type :stream
+ :address-family :file
+ :connect :active
+ :remote-filename path)
+ #+cmu (sys:make-fd-stream (ext:connect-to-unix-socket path kind)
+ :input t :output t :element-type
+ (if bin '(unsigned-byte 8) 'character))
+ #+(and sbcl net.sbcl.sockets)
+ (net.sbcl.sockets:make-socket 'net.sbcl.sockets:unix-stream-socket
+ :buffering :full :path path :type kind)
+ #+(and sbcl db-sockets)
+ (let ((socket (make-instance 'sockets:unix-socket :type :stream)))
+ (sockets:socket-connect socket path)
+ (sockets:socket-make-stream socket :input t :output t
+ :buffering :none
+ :element-type '(unsigned-byte 8)))
+ #-(or allegro cmu (and sbcl (or net.sbcl.sockets db-sockets)))
+ (open path :element-type (if bin '(unsigned-byte 8) 'character)
+ :direction :io))
+
+;;;
+;;; }}}{{{ conditions
+;;;
+
+(defun report-network-condition (cc out)
+ (declare (stream out))
+ (format out "[~s] ~s:~d~@[ ~?~]" (net-proc cc) (net-host cc)
+ (net-port cc) (net-mesg cc) (net-args cc)))
+
+(define-condition network (error)
+ ((proc :type symbol :reader net-proc :initarg :proc :initform nil)
+ (host :type simple-string :reader net-host :initarg :host :initform "")
+ (port :type (unsigned-byte 16) :reader net-port :initarg :port :initform 0)
+ (mesg :type (or null simple-string) :reader net-mesg
+ :initarg :mesg :initform nil)
+ (args :type list :reader net-args :initarg :args :initform nil))
+ (:report report-network-condition))
+
+(define-condition timeout (network)
+ ((time :type (real 0) :reader timeout-time :initarg :time :initform 0))
+ (:report (lambda (cc out)
+ (declare (stream out))
+ (report-network-condition cc out)
+ (when (plusp (timeout-time cc))
+ (format out " [timeout ~a sec]" (timeout-time cc))))))
+
+(define-condition login (network) ())
+(define-condition net-path (network) ())
+
+;;;
+;;; }}}{{{ `socket-service-port'
+;;;
+
+(defstruct servent
+ "see getservbyname(3) for details"
+ (name "" :type simple-string) ; official name of service
+ (aliases nil :type list) ; alias list
+ (port -1 :type fixnum) ; port service resides at
+ (proto :tcp :type symbol)) ; protocol to use
+
+(defun socket-service-port (&optional service (protocol "tcp"))
+ "Return the SERVENT structure corresponding to the SERVICE.
+When SERVICE is NIL, return the list of all services."
+ (with-open-file (fl #+unix "/etc/services" #+(or win32 mswindows)
+ (concatenate 'string (getenv "windir")
+ "/system32/drivers/etc/services")
+ :direction :input)
+ (loop :with name :and aliases :and port :and prot :and tokens
+ :for st = (read-line fl nil nil)
+ :until (null st)
+ :unless (or (zerop (length st)) (char= #\# (schar st 0)))
+ :do (setq tokens (string-tokens
+ (nsubstitute
+ #\Space #\/ (subseq st 0 (position #\# st))))
+ name (string-downcase (string (first tokens)))
+ aliases (mapcar (compose string-downcase string)
+ (cdddr tokens))
+ port (second tokens)
+ prot (third tokens)) :and
+ :if service
+ :when (and (string-equal protocol prot)
+ (or (string-equal service name)
+ (member service aliases :test #'string-equal)))
+ :return (make-servent :name name :aliases aliases :port port
+ :proto prot)
+ :end
+ :else :collect (make-servent :name name :aliases aliases :port port
+ :proto prot)
+ :end
+ :end
+ :finally (when service
+ (error "~s: service ~s is not found for protocol ~s"
+ 'socket-service-port service protocol)))))
+
+;;; }}}
+
+(provide :port-net)
+;;; file net.lisp ends here
Added: clfswm/contrib/server/server.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/server.lisp Thu Aug 12 17:30:52 2010
@@ -0,0 +1,257 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Utility
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+;;; Server protocole:
+;;; Server -> Client: orig_key=a generated key crypted with *key*
+;;; Client : build its new_key with orig_key+*key*
+;;; Client -> Server: new_key+(md5 new_key) crypted with new_key
+;;; Server -> Client: check if the keys match and then authenticate the client.
+;;;
+;;; --------------------------------------------------------------------------
+
+
+(format t "Loading the clfswm server code... ")
+
+(pushnew (truename (concatenate 'string *contrib-dir* "contrib/" "server/")) asdf:*central-registry*)
+
+(dbg asdf:*central-registry*)
+
+(asdf:oos 'asdf:load-op :util-server)
+
+(in-package :clfswm)
+
+(use-package :crypt)
+
+(defstruct server-socket stream auth form key)
+
+(defparameter *server-socket* nil)
+(defparameter *server-port* 33333)
+(defparameter *server-allowed-host* '("127.0.0.1"))
+
+(defparameter *server-connection* nil)
+
+(defparameter *server-commands* '("bye" "close" "quit" "info" "clear" "ls[d][v|f] [pattern]"))
+
+
+
+
+
+(defun send-to-client (sock show-prompt-p &rest msg)
+ (dolist (m (if (consp (car msg)) (car msg) msg))
+ (format (server-socket-stream sock) "~A~%" (crypt m (server-socket-key sock)))
+ (force-output (server-socket-stream sock)))
+ (when show-prompt-p
+ (server-show-prompt sock)))
+
+
+(defun server-show-prompt (sock)
+ (send-to-client sock nil (format nil "~A> " (package-name *package*))))
+
+
+(defun read-from-client (sock)
+ (decrypt (read-line (server-socket-stream sock) nil nil) (server-socket-key sock)))
+
+
+
+(defun server-remove-connection (sock)
+ (send-to-client sock nil "Connection closed by server")
+ (multiple-value-bind (local-host local-port remote-host remote-port)
+ (port:socket-host/port (server-socket-stream sock))
+ (declare (ignore local-host local-port))
+ (format t "~&Connection from ~A:~A closed.~%" remote-host remote-port))
+ (close (server-socket-stream sock))
+ (setf *server-connection* (remove sock *server-connection*)))
+
+(defun server-show-info (sock)
+ (send-to-client sock t (format nil "~A" *server-connection*)))
+
+
+(defun server-clear-connection ()
+ (dolist (sock *server-connection*)
+ (handler-case
+ (send-to-client sock t "Server clear connection in progress.")
+ (error ()
+ (server-remove-connection sock)))))
+
+
+(defun server-show-help (sock)
+ (send-to-client sock t (format nil "Availables commandes: ~{~S~^, ~}" *server-commands*)))
+
+
+(defun server-ls (sock line ls-word var-p fun-p &optional show-doc)
+ (let* ((pattern (string-trim '(#\space #\tab) (subseq (string-trim '(#\space #\tab) line) (length ls-word))))
+ (all-search (string= pattern "")))
+ (with-all-internal-symbols (symbol :clfswm)
+ (when (or all-search (symbol-search pattern symbol))
+ (cond ((and var-p (boundp symbol))
+ (send-to-client sock nil (format nil "~A (variable) ~A" symbol
+ (if show-doc
+ (format nil "~& ~A~& => ~A"
+ (documentation symbol 'variable)
+ (symbol-value symbol))
+ ""))))
+ ((and fun-p (fboundp symbol))
+ (send-to-client sock nil (format nil "~A (function) ~A" symbol
+ (if show-doc
+ (documentation symbol 'function)
+ "")))))))
+ (send-to-client sock t "Done.")))
+
+
+
+(defun server-is-allowed-host (stream)
+ (multiple-value-bind (local-host local-port remote-host remote-port)
+ (port:socket-host/port stream)
+ (declare (ignore local-host local-port))
+ (and (member remote-host *server-allowed-host* :test #'string-equal)
+ (equal remote-port *server-port*))))
+
+
+(defun server-handle-new-connection ()
+ (handler-case
+ (let ((stream (and *server-socket* (port:socket-accept *server-socket* :wait 0.01d0))))
+ (when stream
+ (if (server-is-allowed-host stream)
+ (multiple-value-bind (local-host local-port remote-host remote-port)
+ (port:socket-host/port stream)
+ (declare (ignore local-host local-port))
+ (format t "~&New connection from ~A:~A " remote-host remote-port)
+ (let ((new-sock (make-server-socket :stream stream :auth nil :form "" :key *key*))
+ (key (generate-key)))
+ (push new-sock *server-connection*)
+ (send-to-client new-sock nil key)
+ (setf (server-socket-key new-sock) (concatenate 'string key *key*))))
+ (close stream))))
+ (error (c)
+ (format t "Connection rejected: ~A~%" c)
+ (force-output))))
+
+
+(defun server-line-is (line &rest strings)
+ (dolist (str strings)
+ (when (string-equal line str)
+ (return-from server-line-is t)))
+ nil)
+
+
+(defun server-complet-from (sock)
+ (ignore-errors
+ (when (listen (server-socket-stream sock))
+ (let ((line (read-from-client sock)))
+ (cond ((server-line-is line "help") (server-show-help sock))
+ ((server-line-is line "bye" "close" "quit") (server-remove-connection sock))
+ ((server-line-is line "info") (server-show-info sock))
+ ((server-line-is line "clear") (server-clear-connection))
+ ((first-position "lsdv" line) (server-ls sock line "lsdv" t nil t))
+ ((first-position "lsdf" line) (server-ls sock line "lsdf" nil t t))
+ ((first-position "lsd" line) (server-ls sock line "lsd" t t t))
+ ((first-position "lsv" line) (server-ls sock line "lsv" t nil nil))
+ ((first-position "lsf" line) (server-ls sock line "lsf" nil t nil))
+ ((first-position "ls" line) (server-ls sock line "ls" t t nil))
+ (t (setf (server-socket-form sock) (format nil "~A~A~%" (server-socket-form sock) line))))))))
+
+
+
+
+
+(defun server-eval-form (sock)
+ (let* ((result nil)
+ (printed-result
+ (with-output-to-string (*standard-output*)
+ (setf result (handler-case
+ (loop for i in (multiple-value-list
+ (eval (read-from-string (server-socket-form sock))))
+ collect (format nil "~S" i))
+ (error (condition)
+ (format nil "~A" condition)))))))
+ (send-to-client sock nil (ensure-list printed-result))
+ (send-to-client sock t (ensure-list result))
+ (setf (server-socket-form sock) "")))
+
+
+(defun server-handle-form (sock)
+ (server-complet-from sock)
+ (if (server-socket-key sock)
+ (when (ignore-errors (read-from-string (server-socket-form sock)))
+ (server-eval-form sock))
+ (server-show-prompt sock)))
+
+(defun server-handle-auth (sock)
+ (loop for line = (read-from-client sock)
+ while line
+ do
+ (if (string= line (format nil "~A~A" (server-socket-key sock)
+ (md5:md5 (server-socket-key sock))))
+ (progn
+ (setf (server-socket-auth sock) t)
+ (setf (server-socket-form sock) (format nil "~S" "You are now authenticated!"))
+ (server-handle-form sock)
+ (format t "Connection accepted~%")
+ (return-from server-handle-auth nil))
+ (progn
+ (format t "Connection closed~%")
+ (close (server-socket-stream sock))))))
+
+
+(defun server-handle-connection (sock)
+ (handler-case
+ (when (listen (server-socket-stream sock))
+ (if (server-socket-auth sock)
+ (server-handle-form sock)
+ (server-handle-auth sock)))
+ (error (c)
+ (format t "*** Error: ~A~%" c) (force-output)
+ (close (server-socket-stream sock))
+ (setf *server-connection* (remove sock *server-connection*)))))
+
+(defun handle-server ()
+ (server-handle-new-connection)
+ (dolist (sock *server-connection*)
+ (server-handle-connection sock)))
+
+
+
+(defun start-server (&optional port)
+ (save-new-key)
+ (when port
+ (setf *server-port* port))
+ (setf *server-socket* (port:open-socket-server *server-port*))
+ (add-hook *loop-hook* 'handle-server)
+ (format t "*** Server is started on port ~A and is accepting connection only from [~{~A~^, ~}].~2%"
+ *server-port* *server-allowed-host*))
+
+
+
+
+(format t "done.
+
+You can now start a clfswm server with the command (start-server &optional port).
+Only [~{~A~^, ~}] ~A allowed to login on the server~%"
+ *server-allowed-host*
+ (if (or (null *server-allowed-host*) (= (length *server-allowed-host*) 1))
+ "is" "are"))
+
+
+
+
Added: clfswm/contrib/server/test.sh
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/test.sh Thu Aug 12 17:30:52 2010
@@ -0,0 +1,7 @@
+#! /bin/sh
+
+clisp load.lisp "(print 'toto) (print (+ 2 2))" "(leave-frame)" " quit "
+#cmucl -load load.lisp "(print 'toto)" "(print (+ 2 2))" "(leave-frame)" "quit"
+#sbcl --load load.lisp "(print 'toto)" "(print (+ 2 2))" "(leave-frame)" "quit"
+#ccl --load load.lisp -- "(print 'toto)" "(print (+ 2 2))" "(leave-frame)" "quit"
+#/tmp/local/bin/clfswm-client "(print 'toto)" "(print 'toto) (print (+ 2 2))" "(leave-frame)" "quit"
Added: clfswm/contrib/server/test2.sh
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/test2.sh Thu Aug 12 17:30:52 2010
@@ -0,0 +1,18 @@
+#! /bin/sh
+
+EXEC_CMD='(leave-frame)
+(select-previous-level)
+(let ((frame (create-frame \:name \"Test root\" \:x 0.05 \:y 0.05)))
+ (add-frame frame *current-child*)
+ (add-frame (create-frame \:name \"Test 1\" \:x 0.3 \:y 0 \:w 0.7 \:h 1) frame)
+ (add-frame (create-frame \:name \"Test 2\" \:x 0 \:y 0 \:w 0.3 \:h 1) frame)
+ (setf *current-child* (first (frame-child frame))))
+(show-all-children *current-root*)
+quit'
+
+clisp load.lisp "$EXEC_CMD"
+#cmucl -load load.lisp "$EXEC_CMD"
+#sbcl --load load.lisp "$EXEC_CMD"
+#ccl --load load.lisp -- "$EXEC_CMD"
+#/tmp/local/bin/clfswm-client "$EXEC_CMD"
+
Added: clfswm/contrib/server/util-server.asd
==============================================================================
--- (empty file)
+++ clfswm/contrib/server/util-server.asd Thu Aug 12 17:30:52 2010
@@ -0,0 +1,23 @@
+;;;; -*- Mode: Lisp -*-
+;;;; ASDF System Definition
+;;;
+
+(in-package #:asdf)
+
+(defsystem util-server
+ :description ""
+ :licence "GNU Lesser General Public License (LGPL)"
+ :components ((:file "md5")
+ (:file "net")
+ (:file "crypt")
+ (:file "key"
+ :depends-on ("crypt"))))
+
+
+
+
+
+
+
+
+
More information about the clfswm-cvs
mailing list