blob: 2410af43f809c9ce507cd3debf9ea9ff77443030 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
;; -*- Lisp -*-
;; $Id: Telnet.lisp 20 2005-12-27 15:21:23Z bjc $
(defpackage telnet-options
(:use :cl :cl-user :moxie :bjc-utils))
(in-package :telnet-options)
(defconstant +iac+ 255
"Interpret as Command")
(defconstant +se+ 240
"End of subnegotiation parameters.")
(defconstant +nop+ 241
"No operation.")
(defconstant +data-mark+ 242
"The data stream portion of a Synch.
This should always be accompanied
by a TCP Urgent notification.")
(defconstant +break+ 243
"NVT character BRK.")
(defconstant +interrupt-process+ 244
"The function IP.")
(defconstant +abort-output+ 245
"The function AO.")
(defconstant +are-you-there+ 246
"The function AYT.")
(defconstant +erase-character+ 247
"The function EC.")
(defconstant +erase-line+ 248
"The function EL.")
(defconstant +go-ahead+ 249
"The GA signal.")
(defconstant +sb+ 250
"Indicates that what follows is
subnegotiation of the indicated option.")
(defconstant +will+ 251
"Indicates the desire to begin
performing, or confirmation that
you are now performing, the
indicated option.")
(defconstant +wont+ 252
"Indicates the refusal to perform,
or continue performing, the
indicated option.")
(defconstant +do+ 253
"Indicates the request that the
other party perform, or
confirmation that you are expecting
the other party to perform, the
indicated option.")
(defconstant +dont+ 254
"Indicates the demand tha the
other party stop performing,
or confirmation that you are no
longer expecting the other party
to perform, the indicated option.")
(defconstant +option-binary+ 0
"Enable binary (8 bit) data transmission, instead of the stripped 7 bit ASCII default.")
(defconstant +option-echo+ 1
"Enable remote echo, suppressing local echo.")
(defconstant +option-supress-go-ahead+ 3
"Enable go-ahead suppression.")
(defconstant +option-status+ 5
"Enable option spamming for easier negotiations.")
(defconstant +option-timing-mark+ 6
"Return a timing mark when this is recieved.")
(defconstant +option-terminal+ 24
"Return terminal type.")
(defconstant +option-window-size+ 31
"Negotiate about window size.")
(defconstant +option-authentication+ 37
"Negotiate authentication.")
(defconstant +option-environment+ 39
"Negotiate environment variables.")
(defconstant +option-extended-options-list+ 255
"Read the next byte for further options.")
(defconstant +option-mccp1+ 85
"Mud Client Compression Protocol version 1.")
(defconstant +option-mccp2+ 86
"Mud Client Compression Protocol version 2.")
(defconstant +option-msp+ 90
"Mud Sound Protocol.")
(defconstant +option-mxp+ 91
"Mud eXtension Protocol.")
(defun ack-cmd (cmd)
"Computes the ACK code for CMD."
(cond ((eql cmd +do+) +will+)
((eql cmd +will+) +do+)
((eql cmd +dont+) +wont+)
((eql cmd +wont+) +dont+)))
(defun nack-cmd (cmd)
"Computes the NACK code for CMD."
(cond ((eql cmd +do+) +wont+)
((eql cmd +will+) +dont+)
((eql cmd +dont+) +will+)
((eql cmd +wont+) +do+)))
(defun send-option (cmd option)
(let ((options (world-var 'options)))
(unless options
(setf (world-var 'options) (make-hash-table))
(setf options (world-var 'options)))
(unless (eql cmd (gethash option options))
(setf (gethash option options) cmd)
(send-bytes (list +iac+ cmd option)))))
(defun send-bytes (bytes)
(write-array-to-mux *world* bytes))
(defun handle-command-array (array)
"Array is a byte-vector of the complete IAC code, including any IAC characters."
(format t "(handle-command-array ~S)~%" array)
(when (and (> (length array) 1) (eql (elt array 0) +iac+))
(let ((cmd (elt array 1)))
(cond ((or (eql cmd +do+) (eql cmd +will+))
(awhen (aand (> (length array) 2) (elt array 2))
(cond ((eql it +option-timing-mark+)
(send-bytes (list +iac+ ack-cmd cmd) it))
((or (eql it +option-binary+)
(eql it +option-supress-go-ahead+)
(eql it +option-status+)
(eql it +option-msp+)
(eql it +option-mxp+))
(send-option (ack-cmd cmd) it))
(t (send-option (nack-cmd cmd) it)))))
((or (eql cmd +dont+) (eql cmd +wont+))
(awhen (aand (> (length array) 2) (elt array 2))
(send-option (ack-cmd cmd) it)))
(t (format t "Can't handle command ~S.~%" cmd))))))
(add-hook 'handle-command-array :telnet-option-hook)
|
