From: Brian Jiang
Subject: Is there any library in common lisp that similar the "telnetlib" in Python.
Date: 
Message-ID: <1194440061.827015.83160@i13g2000prf.googlegroups.com>
Such a library (telnet client) is very useful to write scripts. I am
considering to port some simple and useful libraries in Python to
common lisp. But I am a common lisp newbie and still not capable of
doing that now :(

From: Volkan YAZICI
Subject: Re: Is there any library in common lisp that similar the "telnetlib" in Python.
Date: 
Message-ID: <1194446226.129344.295100@19g2000hsx.googlegroups.com>
On Nov 7, 2:54 pm, Brian Jiang <········@gmail.com> wrote:
> Such a library (telnet client) is very useful to write scripts. I am
> considering to port some simple and useful libraries in Python to
> common lisp. But I am a common lisp newbie and still not capable of
> doing that now :(

Not one I know of. But you can try and see what you can do on top of
drakma [http://weitz.de/drakma].


Regards.
From: Zach Beane
Subject: Re: Is there any library in common lisp that similar the "telnetlib" in Python.
Date: 
Message-ID: <m3hcjykpto.fsf@unnamed.xach.com>
Volkan YAZICI <·············@gmail.com> writes:

> On Nov 7, 2:54 pm, Brian Jiang <········@gmail.com> wrote:
>> Such a library (telnet client) is very useful to write scripts. I am
>> considering to port some simple and useful libraries in Python to
>> common lisp. But I am a common lisp newbie and still not capable of
>> doing that now :(
>
> Not one I know of. But you can try and see what you can do on top of
> drakma [http://weitz.de/drakma].

What parts of drakma can be re-used for implementing a telnet client?

Zach
From: Volkan YAZICI
Subject: Re: Is there any library in common lisp that similar the "telnetlib" in Python.
Date: 
Message-ID: <1194467289.944326.310710@y42g2000hsy.googlegroups.com>
On Nov 7, 6:01 pm, Zach Beane <····@xach.com> wrote:
> What parts of drakma can be re-used for implementing a telnet client?

AFAIR, it serves as a good example about how to open TCP connections.
Instead of getting lost in CLHS, one can have a rough idea about the
subject. BTW, I don't think implementing a telnet client would need a
that significant work.


Regards.
From: Zach Beane
Subject: Re: Is there any library in common lisp that similar the "telnetlib" in Python.
Date: 
Message-ID: <m3d4ulljza.fsf@unnamed.xach.com>
Volkan YAZICI <·············@gmail.com> writes:

> On Nov 7, 6:01 pm, Zach Beane <····@xach.com> wrote:
>> What parts of drakma can be re-used for implementing a telnet client?
>
> AFAIR, it serves as a good example about how to open TCP connections.
> Instead of getting lost in CLHS, one can have a rough idea about the
> subject. BTW, I don't think implementing a telnet client would need a
> that significant work.

http://groups.google.com/group/comp.lang.lisp/msg/0fa162eaa85efb14
is my favorite article on the topic. It's not straightforward.

Zach
From: Volkan YAZICI
Subject: Re: Is there any library in common lisp that similar the "telnetlib" in Python.
Date: 
Message-ID: <1194547028.292746.70870@e34g2000pro.googlegroups.com>
On Nov 8, 1:22 am, Zach Beane <····@xach.com> wrote:
> > AFAIR, it serves as a good example about how to open TCP connections.
> > Instead of getting lost in CLHS, one can have a rough idea about the
> > subject. BTW, I don't think implementing a telnet client would need a
> > that significant work.
>
> http://groups.google.com/group/comp.lang.lisp/msg/0fa162eaa85efb14
> is my favorite article on the topic. It's not straightforward.

I dunno about the details. Here is the whole Python telnetlib:
http://svn.python.org/view/python/trunk/Lib/telnetlib.py?rev=54608&view=markup


Regards.
From: Brian Jiang
Subject: Re: Is there any library in common lisp that similar the "telnetlib" in Python.
Date: 
Message-ID: <1194575902.983202.103310@v23g2000prn.googlegroups.com>
On Nov 9, 2:37 am, Volkan YAZICI <·············@gmail.com> wrote:
> On Nov 8, 1:22 am, Zach Beane <····@xach.com> wrote:
>
> > > AFAIR, it serves as a good example about how to open TCP connections.
> > > Instead of getting lost in CLHS, one can have a rough idea about the
> > > subject. BTW, I don't think implementing a telnet client would need a
> > > that significant work.
>
> >http://groups.google.com/group/comp.lang.lisp/msg/0fa162eaa85efb14
> > is my favorite article on the topic. It's not straightforward.
>
> I dunno about the details. Here is the whole Python telnetlib:http://svn.python.org/view/python/trunk/Lib/telnetlib.py?rev=54608&vi...
>
> Regards.

Python's telnetlib is quite simple (for all the telnet options, it
just responses "IAC DONT opt" or "IAC WONT opt") and it is enough to
write scripts (e.g., telnet server and check something). I am
translating it from python to common lisp :) The preliminary draft
codes work well.
From: Damien Kick
Subject: Re: Is there any library in common lisp that similar the "telnetlib" in Python.
Date: 
Message-ID: <13jd8ec5gtmuk8f@corp.supernews.com>
Brian Jiang wrote:

> Python's telnetlib is quite simple (for all the telnet options, it
> just responses "IAC DONT opt" or "IAC WONT opt") and it is enough to
> write scripts (e.g., telnet server and check something). I am
> translating it from python to common lisp :) The preliminary draft
> codes work well.

<sigh> If only I would read the entire thread before posting.  Okay, so 
now I'm curious.  I showed you mine.  Now you show me yours.
From: Brian Jiang
Subject: Re: Is there any library in common lisp that similar the "telnetlib" in Python.
Date: 
Message-ID: <1194773714.206762.246800@z24g2000prh.googlegroups.com>
On Nov 11, 2:31 pm, Damien Kick <·····@earthlink.net> wrote:
> Brian Jiang wrote:
> > Python's telnetlib is quite simple (for all the telnet options, it
> > just responses "IAC DONT opt" or "IAC WONT opt") and it is enough to
> > write scripts (e.g., telnet server and check something). I am
> > translating it from python to common lisp :) The preliminary draft
> > codes work well.
>
> <sigh> If only I would read the entire thread before posting.  Okay, so
> now I'm curious.  I showed you mine.  Now you show me yours.


I think I shall be more patient before I rush to do something :)

Mine is rather simple and it is almost the translation from Python's
Telnetlib. I am a common lisp newbie and the codes are not
professional. But it is now enough for me to write scripts (telnet the
server, issue command and wait for the expected response).

It currently only works for LispWorks. I will use USOCKET for socket
stuff later so that it will work in other Lisp implementation. It just
need to modified 2 to 3 lines of codes. But I need some time to learn
how to use ASDF :(

Here are the functions it now exports:
======================================

(defun open-telnet-session (host port)....)
(defun close-telnet-session (tn)....)
(defun read-some (tn &optional block-read)...)
(defun read-until (tn str &key timeout case-insensitive-mode)....)
(defun read-until-2 (tn strings &key timeout case-insensitive-
mode)....)
(defun expect (tn regexp &optional timeout)....)
(defun write-ln (tn str)....)
(defun write-str (tn str)....)


They can be used as follows:
============================

(defun test-2 ()
  (let (tn)
    (setq tn (open-telnet-session "137.117.3.94" 23))

    (princ (read-until tn "ogin:"))
    (write-ln tn "brianjcj")

    (princ (read-until tn "assword:"))
    (write-ln tn "zaq12WSX")
    (princ (read-until tn ">"))

    (write-ln tn "ls")
    (princ (read-until tn ">"))

    (write-ln tn "sleep 2;echo OK")
    (princ (expect tn "OK"))
    (princ (expect tn "OK"))
    (princ (read-some tn))

    (write-ln tn "sleep 1;pwd")
    (princ (read-until-2 tn (list "BRIANJCJ" "rnd94") :timeout 10))
    (princ (read-some tn))

    (write-ln tn "sleep 2;echo case-insensitive-mode")
    (princ (expect tn (cl-ppcre:create-scanner "RND94" :case-
insensitive-mode t)))
    (princ (read-some tn))

    (write-ln tn "exit")

    (close-telnet-session tn)
    ))


Below are the draft codes of the telnetlib. Very draft now :-)
==============================================================

(in-package :cl-user)

(defpackage :telnetlib
  (:use :cl :cl-ppcre)
  (:export :open-telnet-session
           :close-telnet-session
           :read-some
           :read-until
           :read-until-2
           :expect
           :write-ln
           :write-str
           ))

(in-package :telnetlib)


;; Telnet protocol defaults
(defconstant +TELNET_PORT+ 23)

;; Telnet protocol characters (don't change)
;; Brian: actually only a few of them are using now. Just include them
all
;; in case we need them later.
(defconstant +IAC+ (code-char 255)) ;;  "Interpret As Command"
(defconstant +DONT+ (code-char 254))
(defconstant +DO+ (code-char 253))
(defconstant +WONT+ (code-char 252))
(defconstant +WILL+ (code-char 251))
(defconstant +theNULL+ (code-char 0))

(defconstant +SE+ (code-char 240))  ;;  Subnegotiation End
(defconstant +NOP+ (code-char 241))  ;;  No Operation
(defconstant +DM+ (code-char 242))  ;;  Data Mark
(defconstant +BRK+ (code-char 243))  ;;  Break
(defconstant +IP+ (code-char 244))  ;;  Interrupt process
(defconstant +AO+ (code-char 245))  ;;  Abort output
(defconstant +AYT+ (code-char 246))  ;;  Are You There
(defconstant +EC+ (code-char 247))  ;;  Erase Character
(defconstant +EL+ (code-char 248))  ;;  Erase Line
(defconstant +GA+ (code-char 249))  ;;  Go Ahead
(defconstant +SB+ (code-char 250))  ;;  Subnegotiation Begin


;; Telnet protocol options code (don't change)
;; These ones all come from arpa/telnet.h
(defconstant +BINARY+ (code-char 0)) ;;  8-bit data path
(defconstant +ECHO+ (code-char 1)) ;;  echo
(defconstant +RCP+ (code-char 2)) ;;  prepare to reconnect
(defconstant +SGA+ (code-char 3)) ;;  suppress go ahead
(defconstant +NAMS+ (code-char 4)) ;;  approximate message size
(defconstant +STATUS+ (code-char 5)) ;;  give status
(defconstant +TM+ (code-char 6)) ;;  timing mark
(defconstant +RCTE+ (code-char 7)) ;;  remote controlled transmission
and echo
(defconstant +NAOL+ (code-char 8)) ;;  negotiate about output line
width
(defconstant +NAOP+ (code-char 9)) ;;  negotiate about output page
size
(defconstant +NAOCRD+ (code-char 10)) ;;  negotiate about CR
disposition
(defconstant +NAOHTS+ (code-char 11)) ;;  negotiate about horizontal
tabstops
(defconstant +NAOHTD+ (code-char 12)) ;;  negotiate about horizontal
tab disposition
(defconstant +NAOFFD+ (code-char 13)) ;;  negotiate about formfeed
disposition
(defconstant +NAOVTS+ (code-char 14)) ;;  negotiate about vertical tab
stops
(defconstant +NAOVTD+ (code-char 15)) ;;  negotiate about vertical tab
disposition
(defconstant +NAOLFD+ (code-char 16)) ;;  negotiate about output LF
disposition
(defconstant +XASCII+ (code-char 17)) ;;  extended ascii character set
(defconstant +LOGOUT+ (code-char 18)) ;;  force logout
(defconstant +BM+ (code-char 19)) ;;  byte macro
(defconstant +DET+ (code-char 20)) ;;  data entry terminal
(defconstant +SUPDUP+ (code-char 21)) ;;  supdup protocol
(defconstant +SUPDUPOUTPUT+ (code-char 22)) ;;  supdup output
(defconstant +SNDLOC+ (code-char 23)) ;;  send location
(defconstant +TTYPE+ (code-char 24)) ;;  terminal type
(defconstant +EOR+ (code-char 25)) ;;  end or record
(defconstant +TUID+ (code-char 26)) ;;  TACACS user identification
(defconstant +OUTMRK+ (code-char 27)) ;;  output marking
(defconstant +TTYLOC+ (code-char 28)) ;;  terminal location number
(defconstant +VT3270REGIME+ (code-char 29)) ;;  3270 regime
(defconstant +X3PAD+ (code-char 30)) ;;  X.3 PAD
(defconstant +NAWS+ (code-char 31)) ;;  window size
(defconstant +TSPEED+ (code-char 32)) ;;  terminal speed
(defconstant +LFLOW+ (code-char 33)) ;;  remote flow control
(defconstant +LINEMODE+ (code-char 34)) ;;  Linemode option
(defconstant +XDISPLOC+ (code-char 35)) ;;  X Display Location
(defconstant +OLD_ENVIRON+ (code-char 36)) ;;  Old - Environment
variables
(defconstant +AUTHENTICATION+ (code-char 37)) ;;  Authenticate
(defconstant +ENCRYPT+ (code-char 38)) ;;  Encryption option
(defconstant +NEW_ENVIRON+ (code-char 39)) ;;  New - Environment
variables
;; the following ones come from
;; http://www.iana.org/assignments/telnet-options
;; Unfortunately, that document does not assign identifiers
;; to all of them, so we are making them up
(defconstant +TN3270E+ (code-char 40)) ;;  TN3270E
(defconstant +XAUTH+ (code-char 41)) ;;  XAUTH
(defconstant +CHARSET+ (code-char 42)) ;;  CHARSET
(defconstant +RSP+ (code-char 43)) ;;  Telnet Remote Serial Port
(defconstant +COM_PORT_OPTION+ (code-char 44)) ;;  Com Port Control
Option
(defconstant +SUPPRESS_LOCAL_ECHO+ (code-char 45)) ;;  Telnet Suppress
Local Echo
(defconstant +TLS+ (code-char 46)) ;;  Telnet Start TLS
(defconstant +KERMIT+ (code-char 47)) ;;  KERMIT
(defconstant +SEND_URL+ (code-char 48)) ;;  SEND-URL
(defconstant +FORWARD_X+ (code-char 49)) ;;  FORWARD_X
(defconstant +PRAGMA_LOGON+ (code-char 138)) ;;  TELOPT PRAGMA LOGON
(defconstant +SSPI_LOGON+ (code-char 139)) ;;  TELOPT SSPI LOGON
(defconstant +PRAGMA_HEARTBEAT+ (code-char 140)) ;;  TELOPT PRAGMA
HEARTBEAT
(defconstant +EXOPL+ (code-char 255)) ;;  Extended-Options-List
(defconstant +NOOPT+ (code-char 0))


(defclass Telnet ()
  ((host :initarg :host
         :accessor host)
   (port :initarg :port
         :accessor port
         :initform +TELNET_PORT+)
   (sock-stream :initarg :sock-stream
         :accessor sock-stream)
   (cookedq :accessor cookedq
            :initform (make-array 1024
                                  :element-type 'character
                                  :fill-pointer 0
                                  :adjustable t))
   (eof :accessor eof
        :initform nil)
   (iacseq :accessor iacseq
           :initform (make-array 3
                                 :element-type 'character
                                 :fill-pointer 0))
   (sb :accessor sb
       :initform 0)
   (sbdataq :accessor sbdataq
            :initform (make-array 50
                                  :element-type 'character
                                  :fill-pointer 0
                                  :adjustable t))
   (option-callback :accessor option-callback
                    :initform nil)
   (debug-on :accessor debug-on :initform nil)

   ))

(defun open-telnet-session (host port)
  (let ((tn (make-instance 'Telnet
                           :host host
                           :port port
                           ;; brian
                           :sock-stream
                           ;; Only for lispworks now, will update to
use usocket later.
                           #-:lispworks (make-string-input-stream
"This is the way. This is...")
                           #+:lispworks (comm:open-tcp-stream host
port)
                           )))
    tn))

(defun close-telnet-session (tn)
  (close (sock-stream tn)))

(defun process-sock-stream (tn &optional (block-read nil))
  ""
  (with-slots (sock-stream sb iacseq sbdataq eof cookedq option-
callback debug-on) tn
    (let ((strs (make-array 2))
          c cmd opt
          (len (length cookedq))
          )

      (unless eof
        (if block-read
            (setq c (read-char sock-stream nil :eof))
            (setq c (read-char-no-hang sock-stream nil :eof))))

      (if (eq c :eof)
          (setf eof t))

      (when (or eof (NULL c))
        (if (= 0 len)
            (return-from process-sock-stream :no-data)
            (return-from process-sock-stream :old-data)))

      (setf (aref strs 0) cookedq)
      (setf (aref strs 1) (make-array 50 :element-type
'character :fill-pointer 0 :adjustable t))

      (loop do
           (case (length iacseq)
             ((0) ;; length of iacseq
              (cond
                ((char= c +theNULL+))
                ((char= c (code-char 21)))
                ((char= c +IAC+)
                 ;; option start...
                 (vector-push-extend c iacseq)
                 )
                (t
                 (vector-push-extend c (aref strs sb) 50)
                 )))
             ((1) ;; length of iacseq
              (if (find c (list +DO+ +DONT+ +WILL+ +WONT+))
                  (vector-push-extend c iacseq 50)
                  ;;else
                  (progn
                    (setf (fill-pointer iacseq) 0)
                    (cond
                      ((char= c +IAC+)
                       (vector-push-extend c (aref strs sb) 50)
                       )
                      ((char= c +SB+)
                       (setf sb 1)
                       (setf (fill-pointer sbdataq) 0)
                       )
                      ((char= c +SE+)
                       (setf sb 0)
                       (loop for x across (aref strs 1) do
                            (vector-push-extend x sbdataq 50))
                       (setf (fill-pointer (aref strs 1)) 0)
                       )
                      (t
                       (if option-callback
                           (funcall option-callback sock-stream c
+NOOPT+)
                           (if debug-on (format t "IAC ~d not
recognized" (char-code c)))
                           ))))))
             ((2) ;; length of iacseq
              (setq cmd (aref iacseq 1))
              (setf (fill-pointer iacseq) 0)
              (setq opt c)
              (cond
                ((find cmd (list +DO+ +DONT+))
                 (if debug-on (format t "IAC ~s ~d~%" (if (char= cmd
+DO+) "DO" "DONT") (char-code opt)))
                 (if option-callback
                     (funcall option-callback sock-stream cmd opt)
                     (progn
                       (format sock-stream "~C~C~C" +IAC+ +WONT+ opt)
                       (force-output sock-stream)
                       )))
                ((find cmd (list +WILL+ +WONT+))
                 (if debug-on (format t "IAC ~s ~d~%" (if (char= cmd
+WILL+) "WILL" "WONT") (char-code opt)))
                 (if option-callback
                     (funcall option-callback sock-stream cmd opt)
                     (progn
                       (format sock-stream "~C~C~C" +IAC+ +DONT+ opt)
                       (force-output sock-stream)
                       ))))))
           (setq c (read-char-no-hang sock-stream nil :eof))
           (when (eq c :eof)
             (setf eof t)
             (return))
           until (NULL c)
           )
      (loop for x across (aref strs 1) do
           (vector-push-extend x sbdataq 50))

      (if (/= len (length cookedq))
          :new-data
          (if (= 0 len)
              :no-data
              :old-data)))))

(defun read-some (tn &optional block-read)
  ""
  (with-slots (cookedq) tn
    (when (process-sock-stream tn block-read)
      (prog1
          (copy-seq cookedq)
        (setf (fill-pointer cookedq) 0))
      )))

(defun char-equal-case-insensitive (c1 c2)
  ""
  (or (char= c1 c2)
      (let ((code1 (logior 32 (char-code c1)))
            (code2 (logior 32 (char-code c2))))
        (and (>= code1 (char-code #\a))
             (<= code1 (char-code #\z))
             (= code1 code2))))
  )

(defun read-until (tn str &key timeout case-insensitive-mode)
  ""
  (with-slots (cookedq eof) tn
    (let* (start-time
           (block-read (if timeout nil t))
           pos
           (read-status (process-sock-stream tn block-read))
           data-len
           (search-start 0)
           (str-len (length str))
           (char-test (if case-insensitive-mode #'char-equal-case-
insensitive #'eql))
           )
      (if timeout (setq start-time (get-universal-time)))

      (loop
         do
         (setq data-len (length cookedq))
         (when (>= (- data-len search-start) str-len)
           (if (setq pos (search str cookedq :start2 search-
start :test char-test))
               (progn
                 (setq pos (+ pos (length str)))
                 (return-from read-until (values (read-cookedq tn
pos) :ok)))
               ;; Save the position that we will start searching from
it.
               (setq search-start (+ 2 (- data-len 1 str-len)))
               ))

         (when eof
           (return-from read-until (values nil :eof)))

         ;; loop to wait for the new data...
         (loop do
              (setq read-status (process-sock-stream tn block-read))
              (when (eq read-status :new-data)
                (return))
              (when eof
                (return-from read-until (values nil :eof)))
              (when (and timeout (>= (- (get-universal-time) start-
time) timeout))
                (return-from read-until (values nil :timeout)))
              (if timeout (sleep 0.25))
              )))))

(defun read-until-2 (tn strings &key timeout case-insensitive-mode)
  ""
  (if (= 1 (length strings))
      (read-until tn (elt strings 0) :timeout timeout :case-
insensitive-mode case-insensitive-mode)

      (with-slots (cookedq eof) tn
        (let* (start-time
               (block-read (if timeout nil t))
               work-list
               (char-test (if case-insensitive-mode #'char-equal-case-
insensitive #'eql))
               (read-status (process-sock-stream tn block-read))
               (work-list (loop for s in strings collect (list 0 s
(length s))))
               data-len
               )

          (if timeout (setq start-time (get-universal-time)))

          (loop do
               (setq data-len (length cookedq))
               (loop
                  with j = 0
                  with pos
                  for (search-start str len) in work-list
                  for item in work-list
                  do
                  (when (>= (- data-len search-start) len)
                    (if (setq pos (search str cookedq :start2 search-
start :test char-test))
                        (progn
                          (setq pos (+ pos (length str)))
                          (return-from read-until-2 (values (read-
cookedq tn pos) :ok j)))
                        ;; Save the position that we will start
searching from it.
                        (setf (car item) (+ 2 (- data-len 1 len)))))
                  (incf j))
               (when eof
                 (return-from read-until-2 (values nil :eof)))

             ;; Wait for new data....
               (loop do
                    (setq read-status (process-sock-stream tn block-
read))
                    (when (eq read-status :new-data)
                      (return))
                    (when eof
                      (return-from read-until-2 (values nil :eof)))
                    (when (and timeout (>= (- (get-universal-time)
start-time) timeout))
                      (return-from read-until-2 (values
nil :timeout)))
                    (if timeout (sleep 0.25))
                    ))))))

(defun read-cookedq (tn end-pos)
  ""
  (with-slots (cookedq) tn
    (let (ret-str)
      (setq ret-str (subseq cookedq 0 end-pos))
      (loop
         with j = 0
         for i from end-pos to (1- (length cookedq))
         do
         (setf (aref cookedq j) (aref cookedq i))
         (incf j)
         finally (setf (fill-pointer cookedq) j))
      ret-str)))

(defun expect (tn regexp &optional timeout)
  ""
  (with-slots (cookedq eof) tn
    (let* (start-time
           (block-read (if timeout nil t))
           (read-status (process-sock-stream tn block-read))
           mat-start
           mat-end
           mat-text
           )
      (if timeout (setq start-time (get-universal-time)))
      (unless (eq read-status :no-data)
        (when (multiple-value-setq (mat-start mat-end) (cl-ppcre:scan
regexp cookedq))
          (setq mat-text (subseq cookedq mat-start mat-end))
          (return-from expect (values (read-cookedq tn mat-end) :ok
mat-text))
          ))
      (loop do
           (when eof
             (return-from expect (values nil :eof)))
           (if timeout (sleep 0.25))
           (when (and timeout (>= (- (get-universal-time) start-time)
timeout))
             (return-from expect (values nil :timeout)))
           (setq read-status (process-sock-stream tn block-read))
           (when (eq read-status :new-data)
             (when (multiple-value-setq (mat-start mat-end) (cl-
ppcre:scan regexp cookedq))
               (setq mat-text (subseq cookedq mat-start mat-end))
               (return-from expect (values (read-cookedq tn mat-
end) :ok mat-text))
               ))))))

(defun write-ln (tn str)
  ""
  (format (sock-stream tn) "~a~%" str)
  (force-output (sock-stream tn))
  )

(defun write-str (tn str)
  ""
  (format (sock-stream tn) "~a" str)
  (force-output (sock-stream tn))
  )
From: Volkan YAZICI
Subject: Re: Is there any library in common lisp that similar the "telnetlib" in Python.
Date: 
Message-ID: <1195074130.407142.129000@22g2000hsm.googlegroups.com>
On Nov 11, 11:35 am, Brian Jiang <········@gmail.com> wrote:
> Mine is rather simple and it is almost the translation from Python's
> Telnetlib. I am a common lisp newbie and the codes are not
> professional.

Fine with me. Why not release it as an ASDF-Install'able package with
a cool page on CLiki?


Regards.
From: Brian Jiang
Subject: Re: Is there any library in common lisp that similar the "telnetlib" 	in Python.
Date: 
Message-ID: <e0349a29-4f98-4a68-bc1f-26d441f79c52@a39g2000pre.googlegroups.com>
On Nov 15, 5:02 am, Volkan YAZICI <·············@gmail.com> wrote:
> On Nov 11, 11:35 am, Brian Jiang <········@gmail.com> wrote:
>
> > Mine is rather simple and it is almost the translation from Python's
> > Telnetlib. I am a common lisp newbie and the codes are not
> > professional.
>
> Fine with me. Why not release it as an ASDF-Install'able package with
> a cool page on CLiki?
>
> Regards.

I plan to do that. I just need some spare time now to learn necessary
stuffs of ASDF and ASDF-Install :-|
From: Brian Jiang
Subject: Re: Is there any library in common lisp that similar the "telnetlib" 	in Python.
Date: 
Message-ID: <f85edd1a-9282-4421-b3a5-437d8f6777d9@u10g2000prn.googlegroups.com>
Hi all,

I have ported the telnetlib from python to common lisp. It is quite
useable now and I have written several scripts using it.
I have put it to the google code and created a cliki for it:

http://www.cliki.net/telnetlib

See the link for the details. I hope it is useful for you too.

Regards,
Brian
From: Maciej Katafiasz
Subject: Re: Is there any library in common lisp that similar the "telnetlib" in Python.
Date: 
Message-ID: <fgtb0b$un6$1@news.net.uni-c.dk>
Den Wed, 07 Nov 2007 12:28:09 -0800 skrev Volkan YAZICI:

> On Nov 7, 6:01 pm, Zach Beane <····@xach.com> wrote: BTW, I don't think
> implementing a telnet client would need a that significant work.

TELNET might seem simple, but it's not a simple protocol. The sheer number
of extensions available makes it hard.

Cheers,
Maciej
From: Damien Kick
Subject: Re: Is there any library in common lisp that similar the "telnetlib" in Python.
Date: 
Message-ID: <13jd843q5h07q15@corp.supernews.com>
Brian Jiang wrote:
> Such a library (telnet client) is very useful to write scripts. I am 
> considering to port some simple and useful libraries in Python to 
> common lisp. But I am a common lisp newbie and still not capable of 
> doing that now :(

<sigh> I know I'm going to regret this in the morning, but...

I wrote a weak little approximation of some sort of a telnet client
<http://homepage.mac.com/dkick1/telnet-stream-2007-05-15.tgz>.  However
anemic it may be, though, it did work well enough for me to write some
lisp code to automate telnetting to a box and issuing some commands
on the remote host.  I have mostly used it with Allegro, but I did play
with it and Clisp a bit, if I recall correctly.  Hopefully, someone will
look at it and be disgusted enough to knock out a version which does The
Right Thing but it might serve as a starting point for you, Brian.