ipmsg.lisp

   1
   2 (in-package cl-ipmsg)
   3
   4 (defun msgloop ()
   5   (loop
   6      (format t "~&> ")(force-output)
   7      (let* ((command-line (read-line)))
   8        (when (string/= (subseq command-line (max (1- (length command-line)) 0)) "\\")
   9          (with-input-from-string (s command-line)
  10            (let* ((phrase1 (format nil "~a" (read s nil nil nil)))
  11                   (phrase2 (read s nil nil nil))
  12                   (phrase3 (read s nil nil nil))
  13                   (phrase4 (read s nil nil nil)))
  14              (cond
  15                ((string-equal phrase1 "quit") (return-from msgloop nil))
  16                ((string-equal phrase1 "list")
  17                 (progn
  18                   (format t "~2&Here is the list of your buddies online:~&")
  19                   (loop for i from 0
  20                      below (length (protocol-buddy-list
  21                                     (get-protocol-singleton 'ipmsg-protocol)))
  22                      do (format t "~&~a: ~a~&"
  23                                 (1+ i)
  24                                 (nth i (protocol-buddy-list
  25                                         (get-protocol-singleton 'ipmsg-protocol)))))))
  26                ((string-equal phrase1 "send-ip")
  27                 (send-command-message (get-protocol-singleton 'ipmsg-protocol)
  28                                       phrase2
  29                                       (or phrase4
  30                                           (protocol-port
  31                                               (get-protocol-singleton 'ipmsg-protocol)))
  32                                       :cmd :sendmsg
  33                                       :msg (format nil "~a" phrase3)))
  34                ((string-equal phrase1 "send")
  35                 (let* ((nickname-to-find (format nil "~a" phrase2))
  36                        (target-buddy
  37                         (find-if (lambda (item)
  38                                    (string-equal (getf item :username nil)
  39                                                  nickname-to-find))
  40                                  (protocol-buddy-list
  41                                   (get-protocol-singleton 'ipmsg-protocol)))))
  42                   (if (null target-buddy)
  43                       (format t "~& Error: no such buddy.~%")
  44                       (send-command-message (get-protocol-singleton 'ipmsg-protocol)
  45                                             (format-ip (getf target-buddy :host))
  46                                             (getf target-buddy :port)
  47                                             :cmd :sendmsg
  48                                             :msg (format nil "~a" phrase3)))))
  49                ((string-equal phrase1 "csend")
  50                 (let* ((channel-to-find (format nil "~a" phrase2)))
  51                   (if (not
  52                        (member channel-to-find
  53                                (protocol-channel-list (get-protocol-singleton
  54                                                        'ipmsg-protocol))
  55                                :test #'string-equal))
  56                       (format t "~& Error: no such channel.~%")
  57                       (broadcast-command-message (get-protocol-singleton 'ipmsg-protocol)
  58                                         (protocol-port (get-protocol-singleton
  59                                                 'ipmsg-protocol))
  60                                         :cmd :ext-sendchannelmsg
  61                                         :msg (format nil "~a" phrase3)
  62                                         :exmsg (format nil "~a" phrase2)))))
  63                ((string-equal phrase1 "add-channel")
  64                 (pushnew (format nil "~a" phrase2)
  65                          (protocol-channel-list (get-protocol-singleton 'ipmsg-protocol))
  66                          :test 'equal))
  67                ((string-equal phrase1 "del-channel")
  68                 (let* ((channel-to-find (format nil "~a" phrase2)))
  69                   (if (not
  70                        (member channel-to-find
  71                                (protocol-channel-list (get-protocol-singleton
  72                                                        'ipmsg-protocol)) :test #'equal))
  73                       (format t "~& Error: no such channel.~%")
  74                       (setf (protocol-channel-list (get-protocol-singleton 'ipmsg-protocol))
  75                             (remove-if (lambda (item) (equal item channel-to-find))
  76                                        (protocol-channel-list (get-protocol-singleton
  77                                                                'ipmsg-protocol)))))))
  78                ((or (string-equal phrase1 "help") (string-equal phrase1 "?"))
  79                 (format t "~& Following commands are avaiable:~%~& send~%~& send-ip~%~& list~%~& quit~%~& add-channel~%~& del-channel~%~& csend~2%"))
  80                (t (format t "~&  Unknown command!~%")))))))))
  81
  82 (defun main ()
  83   (showlogo)
  84   (let ((self-info (make-instance 'ipmsg-protocol-selfinfo)))
  85     (setf (user-name self-info) (init-username)
  86           (host-name self-info) (usocket::get-host-name))
  87     (setf (protocol-if (get-protocol-singleton 'ipmsg-protocol))
  88           (init-user-ip-interface)))
  89   (ipmsg-start-server)
  90   (msgloop)
  91   (vendor:quit)
  92   )
  93