cgit.sxemacs.org Git - emchat/blob - emchat-v8.el

   1 ;;; emchat-v8.el --- ICQ v8 for emchat.
   2
   3 ;; Copyright (C) 2004 - 2008 Steve Youngs, Zajcev Evgeny
   4
   5 ;; Author:        Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Maintainer:    Steve Youngs <steve@emchat.org>
   7 ;; Created:       Mon Jun  7 16:20:56 MSD 2004
   8 ;; Keywords:      emchat ICQ protocol
   9
  10 ;; This file is part of EMchat.
  11
  12 ;; Redistribution and use in source and binary forms, with or without
  13 ;; modification, are permitted provided that the following conditions
  14 ;; are met:
  15 ;;
  16 ;; 1. Redistributions of source code must retain the above copyright
  17 ;;    notice, this list of conditions and the following disclaimer.
  18 ;;
  19 ;; 2. Redistributions in binary form must reproduce the above copyright
  20 ;;    notice, this list of conditions and the following disclaimer in the
  21 ;;    documentation and/or other materials provided with the distribution.
  22 ;;
  23 ;; 3. Neither the name of the author nor the names of any contributors
  24 ;;    may be used to endorse or promote products derived from this
  25 ;;    software without specific prior written permission.
  26 ;;
  27 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  28 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  29 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  30 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  31 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  32 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  33 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  34 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  35 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  36 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  37 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  38
  39 ;;; Commentary:
  40
  41 ;; Testing UIN: 286012066, PASS: 123
  42 ;;         UIN: 321529598, PASS: 123
  43 ;;
  44 ;;  The various network packets that make up the ICQv8 protocol.
  45 ;;
  46 ;;  See: <http://www.emchat.org/~steve/icq/docs/>
  47 ;;       <http://iserverd1.khstu.ru/oscar/index.html>
  48
  49 ;;; Code:
  50 \f
  51 (eval-when-compile
  52   (require 'cl)
  53   (defvar emchat-add-user-success))
  54
  55 ;;;; Constants
  56
  57 ;; FLAP channel ids
  58 (defconst emchat-v8-FLAP-HELLO 1)
  59 (defconst emchat-v8-FLAP-SNAC 2)
  60 (defconst emchat-v8-FLAP-ERRORS 3)
  61 (defconst emchat-v8-FLAP-LOGOFF 4)
  62 (defconst emchat-v8-FLAP-PING 5)
  63
  64 (defconst emchat-v8-client-id-string
  65   "ICQ Inc. - Product of ICQ (TM).2002a.5.37.1.3728.85"
  66   "A string to identify ourselves as a nice well behaved ICQ client.")
  67
  68 (defconst emchat-v8-FLAP-VER-MAJOR 5)
  69 (defconst emchat-v8-FLAP-VER-MINOR 37)
  70 (defconst emchat-v8-FLAP-VER-LESSER 1)
  71 (defconst emchat-v8-FLAP-VER-BUILD 3828)
  72 (defconst emchat-v8-FLAP-VER-SUBBUILD 85)
  73
  74 (defconst emchat-v8-message-types
  75   '(normal
  76     chat-request
  77     url
  78     request-auth
  79     authorize
  80     added
  81     pager
  82     email-express
  83     email-check
  84     card
  85     contact-list)
  86   "List of valid message types.")
  87
  88 (defconst emchat-v8-valid-incoming-handlers
  89   '(connected                           ; args: no
  90     disconnected                        ; args: no
  91     instant-message                     ; args: uin, msg &optional msg-type, time-stamp
  92     offline-message                     ; args: uin, msg &optional msg-type, time-stamp
  93     end-offline-messages                ;
  94     about-general                       ; general info about user
  95     about-more
  96     about-about
  97     srv-error
  98     ;; TODO: add more
  99     )
 100   "List of valid incoming message handlers.
 101
 102 To bind on to handle incoming part of icq v8 proto.")
 103
 104 (defconst emchat-v8-valid-outgoing-handlers
 105   '(
 106     ;; TODO: add some handlers
 107     )
 108   "List of valid outgoing message handlers.
 109
 110 To bind on to handle outgoing part of icq v8 proto.")
 111
 112 (defstruct emchat-v8-ctx
 113   host port                             ; host/port we are currently connected
 114   proc                                  ; emchat network connection
 115   (readingp 0)                          ; non-0 if we are currently reading from emchat context
 116   sequence                              ; current flap sequence
 117
 118   incoming-buffer                               ; where incoming data stored
 119   incoming-handlers
 120   outgoing-buffer                       ; buffer for outgoing messages
 121   outgoing-handles
 122
 123   state                                 ; current state, connecting, connected
 124   userinfo                              ; plist of userinfo '(uin <num> password <passwd>)
 125   plist                                 ; user defined plist
 126   )
 127
 128 (defun emchat-v8-ctx-get-prop (ectx prop)
 129   "Get ECTX's property PROP value."
 130   (plist-get (emchat-v8-ctx-plist ectx) prop))
 131
 132 (defun emchat-v8-ctx-put-prop (ectx prop val)
 133   "Put ECTX's property PROP value VAL."
 134   (setf (emchat-v8-ctx-plist ectx)
 135         (plist-put (emchat-v8-ctx-plist ectx) prop val)))
 136 (put 'emchat-v8-ctx-put-prop 'lisp-indent-function 2)
 137
 138 (defun emchat-v8-ctx-rm-prop (ectx prop)
 139   "Remove ECTX's property PROP."
 140   (setf (emchat-v8-ctx-plist ectx)
 141         (plist-remprop (emchat-v8-ctx-plist ectx) prop)))
 142
 143 (defun emchat-v8-ctx-get-incoming-handlers (ectx h)
 144   (plist-get (emchat-v8-ctx-incoming-handlers ectx) h))
 145
 146 (defun emchat-v8-ctx-add-incoming-handler (ectx h f)
 147   (setf (emchat-v8-ctx-incoming-handlers ectx)
 148         (plist-put (emchat-v8-ctx-incoming-handlers ectx) h
 149                    (cons f (emchat-v8-ctx-get-incoming-handlers ectx h)))))
 150
 151 (defun emchat-v8-ctx-del-incoming-handler (ectx h f)
 152   (setf (emchat-v8-ctx-incoming-handlers ectx)
 153         (plist-put (emchat-v8-ctx-incoming-handlers ectx) h
 154                    (delete f (emchat-v8-ctx-get-incoming-handlers ectx h)))))
 155
 156 (defun emchat-v8-ctx-run-incoming-handler (ectx h &rest args)
 157   (let ((ohs (emchat-v8-ctx-get-incoming-handlers ectx h))
 158         (ih-arguments args))
 159     (when ohs
 160       (declare (special ih-arguments))
 161       (apply 'run-hook-with-args (cons 'ohs (cons ectx args))))))
 162 (put 'emchat-v8-ctx-run-incoming-handler 'lisp-indent-function 2)
 163
 164 (defun emchat-get-arg (kw)
 165   (declare (special ih-arguments))
 166   (plist-get ih-arguments kw))
 167
 168 \f
 169 (defmacro emchat-v8-ctx-msg-to-send (ectx)
 170   `(emchat-v8-ctx-get-prop ,ectx 'message-to-send))
 171 (defsetf emchat-v8-ctx-msg-to-send (ectx) (msg)
 172   `(emchat-v8-ctx-put-prop ,ectx 'message-to-send ,msg))
 173
 174 (defmacro emchat-v8-ctx-pause-p (ectx)
 175   `(emchat-v8-ctx-get-prop ,ectx 'pause-p))
 176 (defsetf emchat-v8-ctx-pause-p (ectx) (pp)
 177   `(if ,pp
 178        (progn
 179          (emchat-v8-ctx-put-prop ,ectx 'pause-p ,pp)
 180          (setf (emchat-v8-ctx-msg-to-send ,ectx) ""))
 181      (emchat-v8-ctx-rm-prop ,ectx 'pause-p)
 182      (emchat-v8-send ,ectx (emchat-v8-ctx-msg-to-send ,ectx))
 183      (setf (emchat-v8-ctx-msg-to-send ,ectx) "")))
 184
 185 \f
 186 (defvar emchat-v8-default-ctx nil
 187   "Internal variable, do not modify.")
 188
 189 (defvar emchat-v8-connections nil
 190   "List if emchat connections.
 191 Internal variable, do not modify.")
 192
 193 (defcustom emchat-v8-debug t
 194   "*Non-nil mean emchat protocol debugging is enabled."
 195   :type 'boolean)
 196
 197 \f
 198 (defvar emchat-debug-buffer "*emchat-debug*")
 199
 200 (defun emchat-v8-debug (msg &rest args)
 201   "Print debug MSG."
 202   (when emchat-v8-debug
 203     (with-current-buffer
 204         (get-buffer-create emchat-debug-buffer)
 205       (save-excursion
 206         (goto-char (point-max))
 207         (insert (apply 'format msg args) "\n")))))
 208
 209 (defun emchat-v8-ctx ()
 210   "Return default EMchat context."
 211   emchat-v8-default-ctx)
 212
 213 ;; FLAP accessors
 214 (defsubst emchat-v8-flap-cid (flap)
 215   (nth 0 flap))
 216 (defsubst emchat-v8-flap-seq (flap)
 217   (nth 1 flap))
 218 (defsubst emchat-v8-flap-data (flap)
 219   (nth 2 flap))
 220
 221 ;;; SNAC accessors
 222 (defsubst emchat-v8-snac-family (snac)
 223   (nth 0 snac))
 224 (defsubst emchat-v8-snac-subtype (snac)
 225   (nth 1 snac))
 226 (defsubst emchat-v8-snac-flags (snac)
 227   (nth 2 snac))
 228 (defsubst emchat-v8-snac-rid (snac)
 229   (nth 3 snac))
 230
 231 ;;; TLV accessors
 232 (defsubst emchat-v8-tlv-type (tlv)
 233   (nth 0 tlv))
 234 (defsubst emchat-v8-tlv-len (tlv)
 235   (nth 1 tlv))
 236 (defsubst emchat-v8-tlv-val (tlv)
 237   (nth 2 tlv))
 238 (defsubst emchat-v8-tlv-str (tlv)
 239   (aref (emchat-v8-tlv-val tlv) 0))
 240 (defsubst emchat-v8-tlv-num (tlv)
 241   (truncate (emchat-v8-string->number
 242    (aref (emchat-v8-tlv-val tlv) 0) (truncate (emchat-v8-tlv-len tlv)))))
 243
 244 (defun emchat-v8-util-encrypt (password)
 245   (let ((tb "\xf3\x26\x81\xc4\x39\x86\xdb\x92\x71\xa3\xb9\xe6\x53\x7a\x95\x7c")
 246         (res (make-string (length password) ?\x00))
 247         (idx 0))
 248     (while (< idx (length password))
 249       (aset res idx (logxor (aref password idx) (aref tb (mod idx 16))))
 250       (setq idx (1+ idx)))
 251     res))
 252
 253 (defun emchat-v8-create-ctx (uin &optional password &rest plist)
 254   "Create new emchat context using UIN/PASSWORD.
 255 PLIST is ectx properties list"
 256   (let ((ectx (make-emchat-v8-ctx :state 'disconnected :plist plist)))
 257     (setf (emchat-v8-ctx-userinfo ectx)
 258           (list 'uin uin 'password password))
 259     ectx))
 260
 261 (defun emchat-v8-connect (ectx &optional server port)
 262   "Connect to SERVER and PORT."
 263   (unless server
 264     (setq server (or (emchat-v8-ctx-host ectx) "login.icq.com")))
 265   (unless port
 266     (setq port (or (emchat-v8-ctx-host ectx) 5190)))
 267
 268   (setf (emchat-v8-ctx-host ectx) server)
 269   (setf (emchat-v8-ctx-port ectx) port)
 270
 271   (let* ((proc (open-network-stream (format "emchat-v8-%s:%d" server port) nil
 272                                     server port))
 273          (state (emchat-v8-ctx-state ectx)))
 274
 275     (setf (emchat-v8-ctx-proc ectx) proc)
 276     (setf (emchat-v8-ctx-sequence ectx) (random 65536))
 277
 278     ;; Store connection in emchat connections list
 279     (push ectx emchat-v8-connections)
 280
 281     (set-process-filter proc 'emchat-v8-proc-filter-proccessing)
 282     (set-process-sentinel proc 'emchat-v8-proc-sentinel)
 283
 284     (emchat-v8-debug "Connecting from state=%S" (emchat-v8-ctx-state ectx))
 285
 286     ;; Adjust ECTX state
 287     (cond ((or (eq state 'connecting)
 288                (eq state 'closed))
 289            (setf (emchat-v8-ctx-state ectx) 'connected))
 290           (t (setf (emchat-v8-ctx-state ectx) 'connecting)))
 291     ectx))
 292
 293 (defun emchat-v8-close (ectx)
 294   "Close ECTX connection."
 295   (setf (emchat-v8-ctx-state ectx) 'closed)
 296   (emchat-v8-proc-sentinel (emchat-v8-ctx-proc ectx)))
 297
 298 (defun emchat-v8-send (ectx msg)
 299   "Using emchat context ECTX, send message MSG."
 300   (if (not (emchat-v8-ctx-pause-p ectx))
 301       (process-send-string (emchat-v8-ctx-proc ectx) msg)
 302     ;; Add MSG to the pending data pending
 303     (setf (emchat-v8-ctx-msg-to-send ectx)
 304           (concat (emchat-v8-ctx-msg-to-send ectx) msg))))
 305 (put 'emchat-v8-send 'lisp-indent-function 1)
 306
 307 (defun emchat-v8-send-flush (ectx)
 308   "Flush ECTX's output buffer."
 309   (when (> (length (emchat-v8-ctx-outgoing-buffer ectx)) 0)
 310     (process-send-string
 311      (emchat-v8-ctx-proc ectx)
 312      (emchat-v8-ctx-outgoing-buffer ectx))))
 313
 314 (defun emchat-v8-proc-find (proc)
 315   "Find emchat context by PROC."
 316   (let ((ecs emchat-v8-connections))
 317     (while (and ecs (not (eq (emchat-v8-ctx-proc (car ecs)) proc)))
 318       (setq ecs (cdr ecs)))
 319     (car ecs)))
 320
 321 (defun emchat-v8-proc-sentinel (proc &optional event)
 322   "Sentinel for emchat PROC."
 323   (let ((ectx (emchat-v8-proc-find proc)))
 324     (when (emchat-v8-ctx-p ectx)
 325
 326       (emchat-v8-debug "Removing process %S, state=%S, c-t=%S"
 327                      proc (emchat-v8-ctx-state ectx) (emchat-v8-ctx-get-prop ectx 'connect-tries))
 328       (delete-process proc)
 329       (setf (emchat-v8-ctx-incoming-buffer ectx) "") ;flush input buffer
 330
 331       (setq emchat-v8-connections (delq ectx emchat-v8-connections))
 332       (when (eq (emchat-v8-ctx-state ectx) 'connected)
 333         ;; Unexpected disconnection
 334         (emchat-v8-ctx-run-incoming-handler ectx 'disconnect)))))
 335
 336 (defun emchat-v8-proc-filter-accumulator (proc out)
 337   "Filter for emchat connection to accumulate data."
 338   (let ((ectx (emchat-v8-proc-find proc)))
 339     (when (emchat-v8-ctx-p ectx)
 340       (setf (emchat-v8-ctx-incoming-buffer ectx)
 341             (concat (emchat-v8-ctx-incoming-buffer ectx) out)))))
 342
 343 (defun emchat-v8-proc-filter-proccessing (proc out)
 344   "Filter for emchat connection."
 345   (let ((ectx (emchat-v8-proc-find proc)))
 346     (when (emchat-v8-ctx-p ectx)
 347       (setf (emchat-v8-ctx-incoming-buffer ectx)
 348             (concat (emchat-v8-ctx-incoming-buffer ectx) out))
 349       (enqueue-eval-event 'emchat-v8-fetch-handle-flaps ectx))))
 350
 351 (defvar emchat-v8-snacv-list
 352   '((#x01 . #x04)
 353     (#x13 . #x04)
 354     (#x02 . #x01)
 355     (#x03 . #x01)
 356     (#x15 . #x01)
 357     (#x04 . #x01)
 358     (#x06 . #x01)
 359     (#x09 . #x01)
 360     (#x0A . #x01)
 361     (#x0B . #x01)))
 362
 363 (defconst emchat-v8-snac-list
 364   '(
 365     ;; Family 1, Service
 366     ((#x01 . #x01) "SRV_GEN_ERROR"      emchat-v8-snac-srv-err)
 367     ((#x01 . #x02) "CLI_READY"          nil)
 368     ((#x01 . #x03) "SRV_FAMILIES"       emchat-v8-snac-srv-families)
 369     ((#x01 . #x06) "CLI_RATESREQUEST"   emchat-v8-snac-cli-ratesrequest)
 370     ((#x01 . #x07) "SRV_RATES"          emchat-v8-snac-srv-rates)
 371     ;((#x01 . #x08) "CLI_ACKRATES"       nil) ; handled in SRV_RATES
 372     ((#x01 . #x0A) "SRV_RATE_CHANGE"    emchat-v8-snac-srv-rate-change)
 373     ((#x01 . #x0B) "SRV_SERVERPAUSE"    emchat-v8-snac-srv-pause)
 374     ((#x01 . #x0C) "CLI_ACKSERVERPAUSE" nil)
 375     ((#x01 . #x0E) "CLI_REQINFO"        nil)
 376     ((#x01 . #x0F) "SRV_REPLYINFO"      emchat-v8-snac-srv-replyinfo)
 377     ((#x01 . #x12) "SRV_MIGRATIONREQ"   emchat-v8-snac-srv-migrate)
 378     ((#x01 . #x13) "SRV_MOTD"           emchat-v8-snac-srv-motd)
 379     ((#x01 . #x17) "CLI_FAMILIES"       nil)
 380     ((#x01 . #x18) "SRV_FAMILIES2"      emchat-v8-snac-srv-families2)
 381     ((#x01 . #x1E) "CLI_SETSTATUS"      nil)
 382     ((#x01 . #x21) "BART_REQUEST"       emchat-v8-snac-bart-request)
 383     ;; Family 2, Location
 384     ((#x02 . #x01) "SRV_GEN_ERROR"      emchat-v8-snac-srv-err)
 385     ((#x02 . #x02) "CLI_REQLOCATION"    nil)
 386     ((#x02 . #x03) "SRV_REPLYLOCATION"  emchat-v8-snac-srv-reply-location)
 387     ((#x02 . #x04) "CLI_SETUSERINFO"    nil)
 388     ;; Family 3, Buddy lists (looks like AOL has turned this off)
 389     ((#x03 . #x01) "SRV_CONTACTERR"     emchat-v8-snac-srv-contact-err)
 390     ((#x03 . #x02) "CLI_REQBUDDY"       nil)
 391     ((#x03 . #x03) "SRV_REPLYBUDDY"     emchat-v8-snac-srv-reply-buddy)
 392     ((#x03 . #x04) "CLI_ADDCONTACT"     nil)
 393     ((#x03 . #x05) "CLI_REMCONTACT"     nil)
 394     ((#x03 . #x0A) "SRV_REFUSE"         emchat-v8-snac-srv-cont-refused)
 395     ((#x03 . #x0B) "SRV_USERONLINE"     emchat-v8-snac-srv-user-online)
 396     ((#x03 . #x0C) "SRV_USEROFFLINE"    emchat-v8-snac-srv-user-offline)
 397     ;; Family 4, ICBM
 398     ((#x04 . #x01) "SRV_ICBMERR"        emchat-v8-snac-srv-icbm-err)
 399     ((#x04 . #x02) "CLI_SETICBM"        nil)
 400     ((#x04 . #x04) "CLI_REQICBM"        nil)
 401     ((#x04 . #x05) "SRV_REPLYICBM"      emchat-v8-snac-srv-reply-icbm)
 402     ((#x04 . #x06) "CLI_SENDMSG"        nil)
 403     ((#x04 . #x07) "SRV_RECVMSG"        emchat-v8-snac-srv-recv-msg)
 404     ((#x04 . #x0A) "SRV_MISSED_ICBM"    emchat-v8-snac-srv-missed-icbm)
 405     ((#x04 . #x0B) "SRV/CLI_ACKMSG"     emchat-v8-snac-srv-ack-msg)
 406     ((#x04 . #x0C) "SRV_SRVACKMSG"      emchat-v8-snac-srv-srv-ack-msg)
 407     ;; Family 5, Advertising NOT USED (thank god!)
 408     ;; Family 6, Invitation (Invite somebody to AIM) erm, EMchat won't!!
 409     ;; Family 7, Admin (AIM)
 410     ;; Family 8, Popup Notices (AIM)
 411     ;; Family 9, Privacy
 412     ((#x09 . #x01) "SRV_GEN_ERROR"      emchat-v8-snac-srv-err)
 413     ((#x09 . #x02) "CLI_REQBOS"         nil)
 414     ((#x09 . #x03) "SRV_REPLYBOS"       emchat-v8-snac-srv-reply-bos)
 415     ((#x09 . #x05) "CLI_ADDVISIBLE"     emchat-v8-snac-cli-addvisible)
 416     ((#x09 . #x06) "CLI_REMVISIBLE"     emchat-v8-snac-cli-remvisible)
 417     ((#x09 . #x07) "CLI_ADDINVISIBLE"   emchat-v8-snac-cli-addinvisible)
 418     ((#x09 . #x08) "CLI_REMINVISIBLE"   emchat-v8-snac-cli-reminvisible)
 419     ;; Family a [10], User Lookup (AIM and no longer used)
 420     ;; Family b [11], Usage Stats Interval
 421     ((#x0B . #x01) "SRV_GEN_ERROR"      emchat-v8-snac-srv-err)
 422     ((#x0B . #x02) "SRV_SETINTERVAL"    emchat-v8-snac-srv-set-interval)
 423     ;; Family c [12], Translation Service (deprecated (AIM))
 424     ;; Family d [13], Chat Navigation (AIM)
 425     ;; Family e [14], Chat Service (AIM)
 426     ;; Family f [15], Directory Search (AIM)
 427     ;; Family 10 [16], Server Stored Buddy Icons
 428     ;; Family 13 [19], Server Side Info
 429     ((#x13 . #x01) "SRV_GEN_ERROR" emchat-v8-snac-srv-err)
 430     ((#x13 . #x02) "CLI_SSI_RIGHTS_REQUEST" emchat-v8-snac-cli-ssi-right-request)
 431     ((#x13 . #x03) "SRV_SSI_RIGHTS_REPLY" emchat-v8-snac-srv-ssi-rights-reply)
 432     ((#x13 . #x04) "CLI_SSI_REQUEST" emchat-v8-snac-cli-ssi-request)
 433     ((#x13 . #x05) "CLI_SSI_CHECKOUT" emchat-v8-snac-cli-ssi-checkout)
 434     ((#x13 . #x06) "SRV_SSI_REPLY" emchat-v8-snac-srv-ssi-reply)
 435     ((#x13 . #x07) "CLI_SSI_ACTIVATE" emchat-v8-snac-cli-ssi-activate)
 436     ((#x13 . #x08) "CLI_SSI_ADD" emchat-v8-snac-cli-ssi-add) ; broken
 437     ((#x13 . #x09) "CLI_SSI_UPDATE" emchat-v8-snac-cli-ssi-update) ; not implimented yet
 438     ((#x13 . #x0A) "CLI_SSI_DELETE" emchat-v8-snac-cli-ssi-delete) ; not implimented yet
 439     ((#x13 . #x0E) "SRV_SSI_MOD_ACK" emchat-v8-snac-srv-ssi-mod-ack)
 440     ((#x13 . #x0F) "SRV_SSI_UP_TO_DATE" emchat-v8-snac-srv-ssi-up-to-date)
 441     ((#x13 . #x11) "CLI_SSI_EDIT_BEGIN" emchat-v8-snac-cli-ssi-edit-begin)
 442     ((#x13 . #x12) "CLI_SSI_EDIT_END" emchat-v8-snac-cli-ssi-edit-end)
 443     ((#x13 . #x14) "CLI_SSI_FUTURE_AUTH_GRANT" emchat-v8-snac-cli-ssi-future-auth-grant)
 444     ((#x13 . #x15) "SRV_SSI_FUTURE_AUTH_GRANTED" emchat-v8-snac-srv-ssi-future-auth-granted)
 445     ((#x13 . #x16) "CLI_SSI_DEL_YOURSELF" emchat-v8-snac-cli-ssi-del-yourself)
 446     ((#x13 . #x18) "CLI_SSI_SEND_AUTH_REQUEST" emchat-v8-snac-cli-ssi-send-auth-request)
 447     ((#x13 . #x19) "SRV_SSI_AUTH_REQUEST" emchat-v8-snac-srv-ssi-auth-request)
 448     ((#x13 . #x1A) "CLI_SSI_AUTH_REPLY" emchat-v8-snac-cli-ssi-auth-reply)
 449     ((#x13 . #x1B) "SRV_SSI_AUTH_REPLY" emchat-v8-snac-srv-ssi-auth-reply)
 450     ((#x13 . #x1C) "SRV_SSI_YOU_WERE_ADDED" emchat-v8-snac-srv-ssi-you-were-added)
 451     ;; Family 15 [21], ICQ Specific
 452     ((#x15 . #x01) "SRV_TOICQERR"       emchat-v8-snac-srv-toicqerr)
 453     ;; This is like a family within a family... all the SNACS are #x15,#x02
 454     ;; but they also have types and subtypes to differentiate between them.
 455     ;; So we really don't need a function here.
 456     ((#x15 . #x02) "CLI_TOICQSRV"       nil)
 457     ((#x15 . #x03) "SRV_FROMICQSRV"     emchat-v8-snac-srv-fromicqsrv)
 458     ;; Family 17 [23], Authorisation/Registration
 459     ((#x17 . #x01) "SRV_REGREFUSED"     emchat-v8-snac-srv-regrefused)
 460     ((#x17 . #x05) "SRV_NEWUIN"         emchat-v8-snac-srv-newuin)
 461     ((#x17 . #x04) "CLI_REGISTERUSER"   nil)
 462
 463     ((0 . 0)    "unknown"            nil))
 464   "List of SNAC specs.")
 465
 466 (defun emchat-v8-recv-message (ectx h-type data)
 467   "Receive message."
 468   (let* ((uin (emchat-v8-fetch-uin data))
 469          (msg (emchat-v8-parse-message data
 470                 (list [2 number-swap]   ;year
 471                       [1 number]        ;month
 472                       [1 number]        ;day
 473                       [1 number]        ;hour
 474                       [1 number]        ;minutes
 475                       )))
 476          (tmsg (emchat-v8-parse-message data
 477                  (list [2 number-swap]
 478                        [2 number])))
 479          (ctext (substring (aref data 0) 0 (1- (length (aref data 0)))))
 480          (time-stamp (list (truncate (nth 0 msg))
 481                            (truncate (nth 1 msg))
 482                            (truncate (nth 2 msg))
 483                            (truncate (nth 3 msg))
 484                            (truncate (nth 4 msg)))))
 485
 486     (emchat-v8-debug "Recv-message: '%S', tmsg='%S'" ctext tmsg)
 487
 488     ;; XXX 'normal
 489     (emchat-v8-ctx-run-incoming-handler ectx h-type
 490       :uin uin :msg ctext :msg-type 'normal :time-stamp time-stamp)))
 491
 492 (defmacro emchat-v8-get-alist-value (code alist)
 493   `(cdr (assq ,code ,alist)))
 494
 495 (defconst emchat-v8-countries-alist
 496   '((0 . "Undefined")
 497     (1 . "USA")
 498     (101 . "Anguilla")
 499     (102 . "Antigua")
 500     (1021 . "Antigua & Barbuda")
 501     (103 . "Bahamas")
 502     (104 . "Barbados")
 503     (105 . "Bermuda")
 504     (106 . "British Virgin Islands")
 505     (107 . "Canada")
 506     (108 . "Cayman Islands")
 507     (109 . "Dominica")
 508     (110 . "Dominican Republic")
 509     (111 . "Grenada")
 510     (112 . "Jamaica")
 511     (113 . "Montserrat")
 512     (114 . "Nevis")
 513     (1141 . "Saint Kitts and Nevis")
 514     (115 . "St. Kitts")
 515     (116 . "St. Vincent & the Grenadines")
 516     (117 . "Trinidad & Tobago")
 517     (118 . "Turks & Caicos Islands")
 518     (120 . "Barbuda")
 519     (121 . "Puerto Rico")
 520     (122 . "Saint Lucia")
 521     (123 . "Virgin Islands (USA)")
 522     (178 . "Canary Islands")
 523     (20 . "Egypt")
 524     (212 . "Morocco")
 525     (213 . "Algeria")
 526     (216 . "Tunisia")
 527     (218 . "Libyan Arab Jamahiriya")
 528     (220 . "Gambia")
 529     (221 . "Senegal")
 530     (222 . "Mauritania")
 531     (223 . "Mali")
 532     (224 . "Guinea")
 533     (225 . "Cote d'Ivoire")
 534     (226 . "Burkina Faso")
 535     (227 . "Niger")
 536     (228 . "Togo")
 537     (229 . "Benin")
 538     (230 . "Mauritius")
 539     (231 . "Liberia")
 540     (232 . "Sierra Leone")
 541     (233 . "Ghana")
 542     (234 . "Nigeria")
 543     (235 . "Chad")
 544     (236 . "Central African Republic")
 545     (237 . "Cameroon")
 546     (238 . "Cape Verde Islands")
 547     (239 . "Sao Tome & Principe")
 548     (240 . "Equatorial Guinea")
 549     (241 . "Gabon")
 550     (242 . "Congo, (Rep. of the)")
 551     (243 . "Congo, Democratic Republic of")
 552     (244 . "Angola")
 553     (245 . "Guinea-Bissau")
 554     (246 . "Diego Garcia")
 555     (247 . "Ascension Island")
 556     (248 . "Seychelles")
 557     (249 . "Sudan")
 558     (250 . "Rwanda")
 559     (251 . "Ethiopia")
 560     (252 . "Somalia")
 561     (253 . "Djibouti")
 562     (254 . "Kenya")
 563     (255 . "Tanzania")
 564     (256 . "Uganda")
 565     (257 . "Burundi")
 566     (258 . "Mozambique")
 567     (260 . "Zambia")
 568     (261 . "Madagascar")
 569     (262 . "Reunion Island")
 570     (263 . "Zimbabwe")
 571     (264 . "Namibia")
 572     (265 . "Malawi")
 573     (266 . "Lesotho")
 574     (267 . "Botswana")
 575     (268 . "Swaziland")
 576     (269 . "Mayotte Island")
 577     (2691 . "Comoros")
 578     (27 . "South Africa")
 579     (290 . "St. Helena")
 580     (291 . "Eritrea")
 581     (297 . "Aruba")
 582     (298 . "Faeroe Islands")
 583     (299 . "Greenland")
 584     (30 . "Greece")
 585     (31 . "Netherlands")
 586     (32 . "Belgium")
 587     (33 . "France")
 588     (34 . "Spain")
 589     (350 . "Gibraltar")
 590     (351 . "Portugal")
 591     (352 . "Luxembourg")
 592     (353 . "Ireland")
 593     (354 . "Iceland")
 594     (355 . "Albania")
 595     (356 . "Malta")
 596     (357 . "Cyprus")
 597     (358 . "Finland")
 598     (359 . "Bulgaria")
 599     (36 . "Hungary")
 600     (370 . "Lithuania")
 601     (371 . "Latvia")
 602     (372 . "Estonia")
 603     (373 . "Moldova, Republic of")
 604     (374 . "Armenia")
 605     (375 . "Belarus")
 606     (376 . "Andorra")
 607     (377 . "Monaco")
 608     (378 . "San Marino")
 609     (379 . "Vatican City")
 610     (380 . "Ukraine")
 611     (381 . "Yugoslavia")
 612     (3811 . "Yugoslavia - Serbia")
 613     (382 . "Yugoslavia - Montenegro")
 614     (385 . "Croatia")
 615     (386 . "Slovenia")
 616     (387 . "Bosnia & Herzegovina")
 617     (389 . "Macedonia (F.Y.R.O.M.)")
 618     (39 . "Italy")
 619     (40 . "Romania")
 620     (41 . "Switzerland")
 621     (4101 . "Liechtenstein")
 622     (42 . "Czech Republic")
 623     (4201 . "Slovakia")
 624     (43 . "Austria")
 625     (44 . "United Kingdom")
 626     (441 . "Wales")
 627     (442 . "Scotland")
 628     (45 . "Denmark")
 629     (46 . "Sweden")
 630     (47 . "Norway")
 631     (48 . "Poland")
 632     (49 . "Germany")
 633     (500 . "Falkland Islands")
 634     (501 . "Belize")
 635     (502 . "Guatemala")
 636     (503 . "El Salvador")
 637     (504 . "Honduras")
 638     (505 . "Nicaragua")
 639     (506 . "Costa Rica")
 640     (507 . "Panama")
 641     (508 . "St. Pierre & Miquelon")
 642     (509 . "Haiti")
 643     (51 . "Peru")
 644     (52 . "Mexico")
 645     (53 . "Cuba")
 646     (54 . "Argentina")
 647     (55 . "Brazil")
 648     (56 . "Chile, Republic of")
 649     (57 . "Colombia")
 650     (58 . "Venezuela")
 651     (590 . "Guadeloupe")
 652     (5901 . "French Antilles")
 653     (5902 . "Antilles")
 654     (591 . "Bolivia")
 655     (592 . "Guyana")
 656     (593 . "Ecuador")
 657     (594 . "French Guyana")
 658     (595 . "Paraguay")
 659     (596 . "Martinique")
 660     (597 . "Suriname")
 661     (598 . "Uruguay")
 662     (599 . "Netherlands Antilles")
 663     (60 . "Malaysia")
 664     (61 . "Australia")
 665     (6101 . "Cocos-Keeling Islands")
 666     (6102 . "Cocos (Keeling) Islands")
 667     (62 . "Indonesia")
 668     (63 . "Philippines")
 669     (64 . "New Zealand")
 670     (65 . "Singapore")
 671     (66 . "Thailand")
 672     (670 . "Saipan Island")
 673     (6701 . "Rota Island")
 674     (6702 . "Tinian Island")
 675     (671 . "Guam, US Territory of")
 676     (672 . "Christmas Island")
 677     (6722 . "Norfolk Island")
 678     (673 . "Brunei")
 679     (674 . "Nauru")
 680     (675 . "Papua New Guinea")
 681     (676 . "Tonga")
 682     (677 . "Solomon Islands")
 683     (678 . "Vanuatu")
 684     (679 . "Fiji")
 685     (680 . "Palau")
 686     (681 . "Wallis & Futuna Islands")
 687     (682 . "Cook Islands")
 688     (683 . "Niue")
 689     (684 . "American Samoa")
 690     (685 . "Western Samoa")
 691     (686 . "Kiribati")
 692     (687 . "New Caledonia")
 693     (688 . "Tuvalu")
 694     (689 . "French Polynesia")
 695     (690 . "Tokelau")
 696     (691 . "Micronesia, Federated States of")
 697     (692 . "Marshall Islands")
 698     (7 . "Russia")
 699     (705 . "Kazakhstan")
 700     (706 . "Kyrgyzstan")
 701     (708 . "Tajikistan")
 702     (709 . "Turkmenistan")
 703     (711 . "Uzbekistan")
 704     (81 . "Japan")
 705     (82 . "Korea, South")
 706     (84 . "Viet Nam")
 707     (850 . "Korea, North")
 708     (852 . "Hong Kong")
 709     (853 . "Macau")
 710     (855 . "Cambodia")
 711     (856 . "Laos")
 712     (86 . "China")
 713     (880 . "Bangladesh")
 714     (886 . "Taiwan")
 715     (90 . "Turkey")
 716     (91 . "India")
 717     (92 . "Pakistan")
 718     (93 . "Afghanistan")
 719     (94 . "Sri Lanka")
 720     (95 . "Myanmar")
 721     (960 . "Maldives")
 722     (961 . "Lebanon")
 723     (962 . "Jordan")
 724     (963 . "Syrian Arab Republic")
 725     (964 . "Iraq")
 726     (965 . "Kuwait")
 727     (966 . "Saudi Arabia")
 728     (967 . "Yemen")
 729     (968 . "Oman")
 730     (971 . "United Arabian Emirates")
 731     (972 . "Israel")
 732     (973 . "Bahrain")
 733     (974 . "Qatar")
 734     (975 . "Bhutan")
 735     (976 . "Mongolia")
 736     (977 . "Nepal")
 737     (98 . "Iran (Islamic Republic of)")
 738     (994 . "Azerbaijan")
 739     (995 . "Georgia")
 740     (9999 . "other")))
 741
 742 (defmacro emchat-v8-get-country (code)
 743   "Return country name according to country CODE."
 744   `(emchat-v8-get-alist-value ,code emchat-v8-countries-alist))
 745
 746 (defconst emchat-v8-gender-alist
 747    '((0 . "unspecified")
 748      (1 . "female")
 749      (2 . "male")))
 750
 751 (defmacro emchat-v8-get-gender (code)
 752   "Return gender name according to specified gender CODE."
 753   `(emchat-v8-get-alist-value ,code emchat-v8-gender-alist))
 754
 755 (defconst emchat-v8-languages-alist
 756   '((0 . "not specified")
 757     (1 . "Arabic")
 758     (2 . "Bhojpuri")
 759     (3 . "Bulgarian")
 760     (4 . "Burmese")
 761     (5 . "Cantonese")
 762     (6 . "Catalan")
 763     (7 . "Chinese")
 764     (8 . "Croatian")
 765     (9 . "Czech")
 766     (10 . "Danish")
 767     (11 . "Dutch")
 768     (12 . "English")
 769     (13 . "Esperanto")
 770     (14 . "Estonian")
 771     (15 . "Farsi")
 772     (16 . "Finnish")
 773     (17 . "French")
 774     (18 . "Gaelic")
 775     (19 . "German")
 776     (20 . "Greek")
 777     (21 . "Hebrew")
 778     (22 . "Hindi")
 779     (23 . "Hungarian")
 780     (24 . "Icelandic")
 781     (25 . "Indonesian")
 782     (26 . "Italian")
 783     (27 . "Japanese")
 784     (28 . "Khmer")
 785     (29 . "Korean")
 786     (30 . "Lao")
 787     (31 . "Latvian")
 788     (32 . "Lithuanian")
 789     (33 . "Malay")
 790     (34 . "Norwegian")
 791     (35 . "Polish")
 792     (36 . "Portuguese")
 793     (37 . "Romanian")
 794     (38 . "Russian")
 795     (39 . "Serbian")
 796     (40 . "Slovak")
 797     (41 . "Slovenian")
 798     (42 . "Somali")
 799     (43 . "Spanish")
 800     (44 . "Swahili")
 801     (45 . "Swedish")
 802     (46 . "Tagalog")
 803     (47 . "Tatar")
 804     (48 . "Thau")
 805     (49 . "Turkish")
 806     (50 . "Ukarinian")
 807     (51 . "Urdu")
 808     (52 . "Vietnamese")
 809     (53 . "Yiddish")
 810     (54 . "Yoruba")
 811     (55 . "Afriaans")
 812     (56 . "Bosnian")
 813     (57 . "Persian")
 814     (58 . "Albanian")
 815     (59 . "Armenian")
 816     (60 . "Punjabi")
 817     (61 . "Chamorro")
 818     (62 . "Mongolian")
 819     (63 . "Mandarin")
 820     (64 . "Taiwanese")
 821     (65 . "Macedonian")
 822     (66 . "Sindhi")
 823     (67 . "Welsh")
 824     (68 . "Azerbaijani")
 825     (69 . "Kurdish")
 826     (70 . "Gujarati")
 827     (71 . "Tamil")
 828     (72 . "Belorussian")
 829     (255 . "other")))
 830
 831 (defmacro emchat-v8-get-language (code)
 832   "Return language name according to language CODE."
 833   `(emchat-v8-get-alist-value ,code emchat-v8-languages-alist))
 834
 835 (defconst emchat-v8-marital-alist
 836   '((0 . "not specified")
 837     (10 . "single")
 838     (11 . "in a long-term relationship")
 839     (12 . "engaged")
 840     (20 . "married")
 841     (30 . "divorced")
 842     (31 . "separated")
 843     (40 . "widowed")))
 844
 845 (defmacro emchat-v8-get-marital (code)
 846   "Return marital name according to marital CODE."
 847   `(emchat-v8-get-alist-value ,code emchat-v8-marital-alist))
 848
 849 ;;;; SRV
 850
 851 ;;; Family #x13 (SSI - Server Side Info)
 852
 853 ;;; FIXME: This should most likely be used to set some max values in
 854 ;;; EMchat, but I'm not that concerned seeing as though max contacts
 855 ;;; is 3000.
 856 (defun emchat-v8-snac-srv-ssi-rights-reply (ectx data &optional flags)
 857   "SRV_SSI_RIGHTS_REPLY, SNAC(#x13, #x03)."
 858   (let* ((tlvs (emchat-v8-fetch-tlvs data))
 859          (limits (emchat-v8-tlv-val (emchat-v8-tlv-get tlvs 4)))
 860          (mconts (emchat-v8-fetch-word limits))  ; max contacts
 861          (mgrps (emchat-v8-fetch-word limits))   ; max groups
 862          (mvconts (emchat-v8-fetch-word limits)) ; max visible contacts
 863          (miconts (emchat-v8-fetch-word limits)) ; max invisible contacts
 864          (mvibit (emchat-v8-fetch-word limits))  ; max vis/invis bitmasks
 865          (mpres (emchat-v8-fetch-word limits))   ; max presence info fields
 866          (mignores                               ; max ignore entries
 867           (progn
 868             (dotimes (i 8)
 869               (emchat-v8-fetch-word limits))
 870             (emchat-v8-fetch-word limits)))
 871          ;; rest of the thing is ignored for now (unknown stuff)
 872          )
 873     ;; not sure what to do with this yet, lets just log it for now
 874     (emchat-v8-debug "SRV_SSI_RIGHTS_REPLY: Max number of...
 875 Contacts=%d
 876 Groups=%d
 877 Visible Contacts=%d
 878 Invisible Contacts=%d
 879 Vis/Invis Bitmasks=%d
 880 Presense Info Fields=%d
 881 Ignore List Entries=%d"
 882                      mconts mgrps mvconts miconts mvibit mpres mignores)))
 883
 884 (defvar emchat-v8-ssi-count nil
 885   "A place to store SSI entry count when it spans multiple packets.")
 886
 887 ;;; FIXME: handle BARTs
 888 (defun emchat-v8-snac-srv-ssi-reply (ectx data &optional flags)
 889   "SRV_SSI_REPLY, SNAC(#x13, #x06)."
 890   (let* ((count (progn
 891                   (emchat-v8-fetch-byte data) ; skip, just a version number
 892                   (emchat-v8-fetch-word data)))
 893          lastupd)
 894     (push count emchat-v8-ssi-count)
 895     (dotimes (i count)
 896       (let* ((name (emchat-v8-fetch-bstr data))
 897              (group (emchat-v8-fetch-word data))
 898              (id (emchat-v8-fetch-word data))
 899              (type (emchat-v8-fetch-word data))
 900              (tlvs-len (emchat-v8-fetch-word data))
 901              (tlvs (emchat-v8-fetch-n-tlvs data tlvs-len))
 902              ttype tlen tval)
 903         (while tlvs
 904           (setq ttype (emchat-v8-tlv-type (car tlvs)))
 905           (setq tlen (emchat-v8-tlv-len (car tlvs)))
 906           (setq tval (emchat-v8-tlv-val (car tlvs)))
 907           (when (and (eq ttype #x131) (not (eq type #x14)))
 908             (emchat-world-sync-ssi-maybe name group id tval))
 909           (emchat-v8-debug "SSI_REPLY_TLV:
 910 name=%S group=%S id=%S type=%S
 911 ttype=%S tlength=%S tvalue=%S"
 912                            name group id type ttype tlen tval)
 913           (setq tlvs (cdr tlvs)))))
 914     (with-current-buffer (find-file-noselect emchat-world-rc-filename)
 915       (when (buffer-modified-p)
 916         (save-buffer)))
 917     (when (zerop (logand flags 1))
 918       (when (> (length emchat-v8-ssi-count) 1)
 919         (setq count (apply #'+ emchat-v8-ssi-count)))
 920       (setq emchat-v8-ssi-count nil)
 921       (setq lastupd (emchat-v8-fetch-time data))
 922       (emchat-world-update-world-count count lastupd)
 923       (emchat-v8-debug "SSI_REPLY: count=%S lastupd=%S" count lastupd))))
 924
 925 (defun emchat-v8-snac-srv-ssi-mod-ack (ectx data &optional flags)
 926   "Server ack for buddy add/del/mod.  SNAC(#x13, #x0E)."
 927   (let ((retcodes '((#x0000 . "Success")
 928                     (#x0002 . "Item not found")
 929                     (#x0003 . "Item already exists")
 930                     (#x000A . "Invalid data")
 931                     (#x000C . "Limit exceeded")
 932                     (#x000D . "Can't add ICQ contact to AIM list")
 933                     (#x000E . "Authorisation required"))))
 934     (setq emchat-add-user-success nil)
 935     (while data
 936       (let* ((code (emchat-v8-fetch-word data))
 937              (retstr (cdr (assq code retcodes))))
 938         (emchat-v8-debug "SRV_SSI_MOD_ACK: %s" retstr)
 939         (if (zerop code)
 940             (emchat-v8-ctx-run-incoming-handler 'ectx 'new-user)
 941           (emchat-log-error "SSI Modifications Error: %s" retstr))))))
 942
 943 (defun emchat-v8-snac-srv-ssi-up-to-date (ectx data &optional flags)
 944   "Local copy of SSI is up to date.  SNAC(#x13, #x0F).
 945
 946 This doesn't actually do anything because there isn't any point.  It
 947 sends back the mod time and item count, but you only get this packet
 948 if your local SSI has the same mod time and item count."
 949   (emchat-log-info "Local copy of SSI is up to date!")
 950   (emchat-v8-debug "SRV_SSI_UP_TO_DATE: local SSI is up to date."))
 951
 952
 953 (defun emchat-v8-snac-srv-ssi-auth-reply (ectx data &optional flags)
 954   "SRV_SSI_AUTH_REPLY, SNAC (#x13 . #x1B)"
 955   (let ((buin (emchat-v8-fetch-buin data))
 956         (accept (emchat-v8-fetch-byte data))
 957         (reason (emchat-v8-fetch-bstr data)))
 958     (emchat-v8-debug "AUTHREPLY: from %d %s"
 959                    buin
 960                    (if (zerop accept)
 961                        "rejected"
 962                      "accepted"))
 963     (if (zerop accept)
 964         (emchat-v8-ctx-run-incoming-handler ectx 'auth-reject
 965           :uin buin :msg reason :msg-type 'auth-reject)
 966       (emchat-v8-ctx-run-incoming-handler ectx 'auth-accept
 967         :uin buin :msg reason :msg-type 'auth-accept))))
 968
 969 (defun emchat-v8-snac-srv-ssi-you-were-added (ectx data &optional flags)
 970   "SRV_ADDEDYOU, SNAC (#x13 . #x1C)"
 971   (let ((buin (emchat-v8-fetch-buin data))
 972         (msg "has added you to their contact list."))
 973     (emchat-v8-debug "ADDEDYOU: by %d" buin)
 974     (emchat-v8-ctx-run-incoming-handler ectx 'added-you
 975         :uin buin :msg msg :msg-type 'added)))
 976
 977 (defun emchat-v8-snac-srv-ssi-future-auth-granted (ectx data &optional flags)
 978   "Future auth has been given.  SNAC(#x13, #x15)."
 979   (let ((uin (emchat-v8-fetch-buin data))
 980         (reason (emchat-v8-fetch-bstr data)))
 981     (emchat-v8-debug "SRV_SSI_FUTURE_AUTH_GRANTED: %s grants auth because: %s"
 982                      uin reason)
 983     (emchat-v8-ctx-run-incoming-handler ectx 'auth-accept
 984       :uin uin :msg reason :msg-type 'auth-accept)))
 985
 986 (defun emchat-v8-snac-srv-ssi-auth-request (ectx data &optional flags)
 987   "SRV_SSI_AUTH_REQUEST, SNAC (#x13 . #x19)"
 988   (let ((buin (emchat-v8-fetch-buin data))
 989         (reason (emchat-v8-fetch-bstr data)))
 990     (emchat-v8-debug "AUTHREQ: from %d Reason: %S" buin reason)
 991     (emchat-v8-ctx-run-incoming-handler ectx 'auth-request
 992       :uin buin :msg reason :msg-type 'auth-request)))
 993
 994 ;;; Family #x15 (Old ICQ)
 995
 996 ;;; FIXME: complete this, a fair bit is still missing.  Might need
 997 ;;; splitting up into several functions
 998 (defun emchat-v8-snac-srv-fromicqsrv (ectx data &optional flags)
 999   "SRV_FROMICQSRV, SNAC(#x15, #x03)"
1000   (let* ((tlv1 (emchat-v8-tlv-val (emchat-v8-fetch-single-tlv data)))
1001          (len (emchat-v8-fetch-word-le tlv1))
1002          (my-uin (emchat-v8-fetch-uin tlv1))
1003          (type (emchat-v8-fetch-word-le tlv1))
1004          (seq (emchat-v8-fetch-word-le tlv1))
1005          (his-uin (cdr (assq seq (emchat-v8-ctx-get-prop ectx 'about-query-seq-uin)))))
1006     ;; Shutup compiler
1007     (setq len len my-uin my-uin)
1008
1009     (emchat-v8-debug "FROMICQSRV: UIN: %S, Type=%d, seq=%d, tlv1=%S, data=%S"
1010                    his-uin type seq tlv1 data)
1011
1012     (cond ((= type 65)
1013            (emchat-v8-recv-message ectx 'offline-message tlv1))
1014
1015           ((= type 66)
1016            ;; Ack end of offline messages
1017            (emchat-v8-send ectx
1018              (emchat-v8-pack-meta-snac ectx 62))
1019            (emchat-v8-ctx-run-incoming-handler ectx 'end-offline-messages))
1020
1021           ((= type 2010)
1022            (let ((subtype (emchat-v8-fetch-word-le tlv1))
1023                  (result (emchat-v8-fetch-byte tlv1)))
1024              (emchat-v8-debug "SRV_META: Subtype=%d, result=%d, tlv1=%S" subtype result tlv1)
1025
1026              (when (= result 10)
1027                (cond ((= subtype 200)
1028                       ;; -- Start --
1029                       ;; GENERAL
1030                       (let ((nick (emchat-v8-fetch-lnts tlv1))
1031                             (fname (emchat-v8-fetch-lnts tlv1))
1032                             (sname (emchat-v8-fetch-lnts tlv1))
1033                             (email (emchat-v8-fetch-lnts tlv1))
1034                             (city (emchat-v8-fetch-lnts tlv1))
1035                             (state (emchat-v8-fetch-lnts tlv1))
1036                             (phone (emchat-v8-fetch-lnts tlv1))
1037                             (fax (emchat-v8-fetch-lnts tlv1))
1038                             (street (emchat-v8-fetch-lnts tlv1))
1039                             (cellular (emchat-v8-fetch-lnts tlv1))
1040                             (zip (emchat-v8-fetch-lnts tlv1))
1041                             (country (emchat-v8-get-country
1042                                       (emchat-v8-fetch-word-le tlv1)))
1043                             ;; The timezone the user lives in, as
1044                             ;; multiples of 30minutes relative to UTC.
1045                             (tz (emchat-v8-fetch-byte tlv1))
1046                             (flags (emchat-v8-fetch-byte tlv1))
1047                             (web-ind (= (emchat-v8-fetch-word-le tlv1) 1)))
1048
1049                         (emchat-v8-debug "GENERAL-Info: UIN: %d, Nick: %s"
1050                                        his-uin nick)
1051
1052                         (emchat-v8-ctx-run-incoming-handler ectx 'about-general
1053                           :uin his-uin
1054                           :nick nick :first-name fname :second-name sname
1055                           :email email :city city :state state :phone phone
1056                           :fax fax :street street :cellular cellular
1057                           :zip-code zip :country country :tz tz
1058                           :flags flags :web-indicator web-ind)))
1059
1060                      ((= subtype 210)
1061                       ;; WORK
1062                       ;; Hey!  Does anybody actually care about this? --lg
1063                       )
1064                      ((= subtype 220)
1065                       ;; MORE
1066                       (let ((age (emchat-v8-fetch-word-le tlv1))
1067                             (gender (emchat-v8-get-gender
1068                                      (emchat-v8-fetch-byte tlv1)))
1069                             (homepage (emchat-v8-fetch-lnts tlv1))
1070                             (birth-year (emchat-v8-fetch-word-le tlv1))
1071                             (birth-month (emchat-v8-fetch-byte tlv1))
1072                             (birth-day (emchat-v8-fetch-byte tlv1))
1073                             (lang1 (emchat-v8-get-language
1074                                     (emchat-v8-fetch-byte tlv1)))
1075                             (lang2 (emchat-v8-get-language
1076                                     (emchat-v8-fetch-byte tlv1)))
1077                             (lang3 (emchat-v8-get-language
1078                                     (emchat-v8-fetch-byte tlv1)))
1079                             (ocity (progn
1080                                      (emchat-v8-fetch-word-le tlv1) ; skip
1081                                      (emchat-v8-fetch-lnts tlv1)))
1082                             (ostate (emchat-v8-fetch-lnts tlv1))
1083                             (ocountry (emchat-v8-get-country
1084                                        (emchat-v8-fetch-word-le tlv1)))
1085                             (marital (emchat-v8-get-marital
1086                                       (emchat-v8-fetch-word-le tlv1))))
1087                         (emchat-v8-ctx-run-incoming-handler ectx 'about-more
1088                           :uin his-uin :age age :gender gender :homepage homepage
1089                           :birth-year birth-year :birth-month birth-month
1090                           :birth-day birth-day :lang1 lang1 :lang2 lang2
1091                           :lang3 lang3 :ocity ocity :ostate ostate
1092                           :ocountry ocountry :marital marital)))
1093
1094                      ((= subtype 235)
1095                       ;; EMAILS
1096                       )
1097                      ((= subtype 270)
1098                       ;; META270
1099                       )
1100                      ((= subtype 230)
1101                       ;; ABOUT
1102                       (let ((about-user (emchat-v8-fetch-lnts tlv1)))
1103                         (emchat-v8-debug "USER ABOUT-Info: %S" about-user)
1104                         (emchat-v8-ctx-run-incoming-handler ectx 'about-about
1105                           :uin his-uin :about about-user)))
1106
1107                      ((= subtype 240)
1108                       ;; INTEREST
1109                       )
1110                      ((= subtype 250)
1111                       ;; BACKGROUND
1112                       )
1113
1114                      ((= subtype 420)
1115                       ;; Search found a user
1116                       (let ((uin (progn (emchat-v8-fetch-word-le tlv1)
1117                                         (emchat-v8-fetch-uin tlv1)))
1118                             (nick (emchat-v8-fetch-lnts tlv1))
1119                             (first-name (emchat-v8-fetch-lnts tlv1))
1120                             (last-name (emchat-v8-fetch-lnts tlv1))
1121                             (email (emchat-v8-fetch-lnts tlv1))
1122                             (auth (emchat-v8-fetch-byte tlv1))
1123                             (status (emchat-v8-fetch-word-le tlv1))
1124                             (gender (emchat-v8-get-gender
1125                                      (emchat-v8-fetch-byte tlv1)))
1126                             (age (emchat-v8-fetch-word-le tlv1))
1127                             (missed (emchat-v8-fetch-word-le tlv1)))
1128                         (emchat-v8-debug "FOUND USER: UIN=%d, Nick=%s, missed=%d" uin nick missed)
1129                         (emchat-v8-ctx-run-incoming-handler ectx 'search-found
1130                           :uin uin :nick nick
1131                           :first-name first-name :last-name last-name
1132                           :email email :auth auth :status status :gender gender
1133                           :age age :missed missed)))
1134
1135                      ((= subtype 430)
1136                       ;; Search found a user (the last match from the search)
1137                       (let ((uin (progn (emchat-v8-fetch-word-le tlv1)
1138                                         (emchat-v8-fetch-uin tlv1)))
1139                             (nick (emchat-v8-fetch-lnts tlv1))
1140                             (first-name (emchat-v8-fetch-lnts tlv1))
1141                             (last-name (emchat-v8-fetch-lnts tlv1))
1142                             (email (emchat-v8-fetch-lnts tlv1))
1143                             (auth (emchat-v8-fetch-byte tlv1))
1144                             (status (emchat-v8-fetch-word-le tlv1))
1145                             (gender (emchat-v8-get-gender
1146                                      (emchat-v8-fetch-byte tlv1)))
1147                             (age (emchat-v8-fetch-word-le tlv1))
1148                             (missed (emchat-v8-fetch-word-le tlv1)))
1149                         (emchat-v8-debug "FOUND USER: UIN=%d, Nick=%s, missed=%d" uin nick missed)
1150                         (emchat-v8-ctx-run-incoming-handler ectx 'search-found-last
1151                           :uin uin :nick nick
1152                           :first-name first-name :last-name last-name
1153                           :email email :auth auth :status status :gender gender
1154                           :age age :missed missed)))
1155                      )))))
1156     ))
1157
1158 (defun emchat-v8-snac-srv-toicqerr (ectx data &optional flags)
1159   "SRV_TOICQERR, SNAC(0x15, 0x01)"
1160   (let ((ecode (emchat-v8-fetch-word data))
1161         (tlv1 (emchat-v8-fetch-single-tlv data)))
1162     (error "Malformed TOICQ request" ecode tlv1)))
1163
1164 (defun emchat-v8-snac-srv-set-interval (ectx data &optional flags)
1165   "SRV_SETINTERVAL, SNAC(0x0B, 0x02)"
1166   (let ((ival (emchat-v8-fetch-word data)))
1167     (emchat-v8-debug "User info interval: %S" ival)
1168     (emchat-v8-ctx-put-prop ectx 'user-info-interval ival)))
1169
1170 (defun emchat-v8-snac-srv-icbm-err (ectx data &optional flags)
1171   "SRV_ICBMERR"
1172   (let* ((ival (emchat-v8-fetch-word data))
1173          (err (cond ((= ival 4) "User offline")
1174                     ((= ival 9) "Client does not understand type-2 mesasges")
1175                     ((= ival 14) "Packet was malformed")
1176                     (t "Unknown"))))
1177     (emchat-v8-debug "ICBMERR: %d/%s" ival err)))
1178
1179 (defun emchat-v8-snac-srv-reply-icbm (ectx data &optional flags)
1180   "SRV_REPLICBM, SNAC(#x04, #x05)"
1181   )
1182
1183 (defun emchat-v8-snac-srv-replyinfo (ectx data &optional flags)
1184   "SRV_REPLYINFO, SNAC(1, f)"
1185   ;; BUIN      xx ..                   UIN        The UIN this information is about.
1186   ;; WORD.B    00 00                   WARNING    Probably a warning level left over from OSCAR.
1187   ;; WORD.B    00 xx                   COUNT      Total number of TLVs to follow.
1188   ;; TLV(1)    00 01 00 02 00 80       UNKNOWN    Unknown.
1189   ;; TLV(12)   00 0c 00 25 ...         CLI2CLI    Direct connection info, see CLI_SETSTATUS SNAC(1,30).
1190   ;; TLV(15)   00 0f 00 04 xx xx xx xx UNKNOWN    Number of seconds that user has been online?
1191   ;; TLV(2)    00 02 00 04 TIME        MEMBERTIME The member since time.
1192   ;; TLV(3)    00 03 00 04 TIME        ONLINETIME The online since time.
1193   ;; TLV(5)    00 05 00 04 TIME        UNKNOWN    Some unknown time.
1194   ;; TLV(6)    00 06 00 04 xx xx xx xx STATUS     The current online status.
1195   ;; TLV(30)   00 1e 00 04 00 00 00 00 UNKNOWN    Unknown: empty.
1196 ;  (let* ((uin (emchat-v8-fetch-buin data))
1197 ;         (tlvs (progn
1198 ;                 (emchat-v8-fetch-word data) ; skip (warning)
1199 ;                 (emchat-v8-fetch-word data) ; skip (tlv count)
1200 ;                 (emchat-v8-fetch-tlvs data)))
1201 ;         (tlv12 (emchat-v8-tlv-get tlvs 12))) ;  CLI2CLI
1202
1203 ;    (emchat-v8-debug "SRV_REPLYINFO: UIN=%d tlv12=%S" uin tlv12)
1204 ;    ))
1205   )
1206
1207 (defun emchat-v8-snac-srv-reply-buddy (ectx data &optional flags)
1208   "SRV_REPLYBUDDY, SNAC(0x03, 0x03)"
1209   (let* ((tlvs (emchat-v8-fetch-tlvs data))
1210          (muaicl (emchat-v8-tlv-get tlvs 1)) ;maximum uins allowed in contact list
1211          (mpchuu (emchat-v8-tlv-get tlvs 2))) ;maximum number of people that can have our uin in contact list
1212     (when muaicl
1213       (emchat-v8-ctx-put-prop ectx 'maximum-uins (emchat-v8-tlv-num muaicl)))
1214     (when mpchuu
1215       (emchat-v8-ctx-put-prop ectx 'maximum-people (emchat-v8-tlv-num mpchuu)))))
1216
1217 (defun emchat-v8-snac-srv-user-online (ectx data &optional flags)
1218   "SRV_USERONLINE, SNAC(0x03, 0x0B)."
1219   (let* ((buin (emchat-v8-fetch-buin data))
1220          (tlvs (progn
1221                  (emchat-v8-fetch-data data 4) ; skip
1222                  (emchat-v8-fetch-tlvs data)))
1223          (ts (emchat-v8-tlv-get tlvs 6))
1224          ;; XXX use only last 2 bytes of status
1225          (new-status (and ts (emchat-v8-find-status
1226                               (progn
1227                                 (emchat-v8-fetch-word (emchat-v8-tlv-val ts))
1228                                 (emchat-v8-fetch-word (emchat-v8-tlv-val ts)))))))
1229     (emchat-v8-debug "SRV_USERONLINE: uin=%d status=%S/%S"
1230                    buin ts new-status)
1231     (when new-status
1232       (emchat-v8-ctx-run-incoming-handler ectx 'status-update
1233         buin new-status))))
1234
1235 (defun emchat-v8-snac-srv-user-offline (ectx data &optional flags)
1236   "SRV_USEROFFLINE, SNAC(0x03, 0x0C)"
1237   (let ((buin (emchat-v8-fetch-buin data)))
1238     (emchat-v8-debug "SRV_USEROFFLINE: uin=%d" buin)
1239     (emchat-v8-ctx-run-incoming-handler ectx 'status-update
1240       buin 'offline)))
1241
1242 (defun emchat-v8-snac-srv-reply-location (ectx data &optional flags)
1243   "SRV_REPLYLOCATION, SNAC(0x02, 0x03)."
1244   ;; TODO: -write me
1245   (let* ((tlvs (emchat-v8-fetch-tlvs data))
1246          (mcap (emchat-v8-tlv-get tlvs 2)))
1247     (when mcap
1248       ;; Set maximum capabilities
1249       (emchat-v8-debug "max capabilities: %S" (emchat-v8-tlv-num mcap))
1250       (emchat-v8-ctx-put-prop ectx 'maximum-capabilities (emchat-v8-tlv-num mcap)))))
1251
1252 (defun emchat-v8-snac-srv-families (ectx data &optional flags)
1253   "SRV_FAMILIES, SNAC(0x01, 0x03)."
1254   (let (srv-families)
1255     (while (> (length (aref data 0)) 0)
1256       (setq srv-families
1257             (cons (emchat-v8-fetch-word data) srv-families)))
1258     (emchat-v8-ctx-put-prop ectx 'server-families srv-families))
1259
1260   (emchat-v8-debug "SRV-FAMILIES %S" (emchat-v8-ctx-get-prop ectx 'server-families))
1261   (emchat-v8-snac-cli-families ectx))
1262
1263 (defun emchat-v8-snac-srv-families2 (ectx data &optional flags)
1264   "SRV_FAMILIES2, SNAC(0x01, 0x12)."
1265   (emchat-v8-debug "SRV-FAMILIES2 %S" data)
1266   )
1267
1268 (defun emchat-v8-snac-bart-request (ectx data &optional flags)
1269   "BART_REQUEST, SNAC(0x01, 0x21)."
1270   (let* ((type (emchat-v8-fetch-word data))
1271          (flag (emchat-v8-fetch-byte data))
1272          (len_opaque (emchat-v8-fetch-byte data))
1273          (opaque (emchat-v8-fetch-data data len_opaque)))
1274     (emchat-v8-debug "[BART]...
1275 Type: %S
1276 Flag: %S
1277 len:  %S
1278 opaque: %S"
1279                      type flag len_opaque opaque)))
1280
1281 (defun emchat-v8-snac-srv-rates (ectx data &optional flags)
1282   "SRV_RATES, SNAC(0x01, 0x07)."
1283   (let ((nr (emchat-v8-parse-message
1284              data
1285              (list
1286               [2 emchat-v8-length-1]
1287               [emchat-v8-length-1
1288                ([2 number]              ; Rate class ID
1289                 [4 number]              ; Window size
1290                 [4 number]              ; Clear level
1291                 [4 number]              ; Alert level
1292                 [4 number]              ; Limit level
1293                 [4 number]              ; Disconnect level
1294                 [4 number]              ; Current level
1295                 [4 number]              ; Max level
1296                 [4 number]              ; last time
1297                 [1 number])]            ; current state
1298               [emchat-v8-length-1
1299                ([2 number]              ; Rate class ID
1300                 [2 emchat-v8-length-2]  ; number of pairs in group
1301                 [emchat-v8-length-2 ([4 number])])]))))
1302
1303     (emchat-v8-debug "SRV_RATES: %S" nr)
1304
1305     ;; Send a reply
1306     (when (cadr nr)
1307       (emchat-v8-send ectx
1308         (emchat-v8-pack-snac ectx '(#x01 . #x08)
1309           (apply 'concat
1310                  (mapcar 'emchat-v8-pack-word (mapcar 'car (nth 1 nr)))))))
1311     ))
1312
1313 (defun emchat-v8-snac-srv-rate-change (ectx data &optional flags)
1314   "SRV_RATE_CHANGE, SNAC(#x01, #x0A)."
1315   (let ((code (emchat-v8-fetch-word data))
1316         (rateid (emchat-v8-fetch-word data))
1317         (winsize (emchat-v8-fetch-dword data))
1318         (clear (emchat-v8-fetch-dword data))
1319         (alert (emchat-v8-fetch-dword data))
1320         (limit (emchat-v8-fetch-dword data))
1321         (discon (emchat-v8-fetch-dword data))
1322         (currl (emchat-v8-fetch-dword data))
1323         (max (emchat-v8-fetch-dword data))
1324         (ltime (emchat-v8-fetch-dword data))
1325         (currs (emchat-v8-fetch-byte data)))
1326     (emchat-v8-debug
1327      "[SRV_RATE_EXCEEDED]:
1328     Message Code: %d
1329    Rate Class ID: %d
1330      Window Size: %d
1331      Clear Level: %d
1332      Alert Level: %d
1333      Limit Level: %d
1334 Disconnect Level: %d
1335    Current Level: %d
1336        Max Level: %d
1337        Last Time: %d
1338    Current State: %d"
1339      code rateid winsize clear alert limit discon currl max ltime currs)
1340     (ecase code
1341       (1 #'ignore)
1342       (2 (emchat-log-info "You've reached the rate limit: %d
1343 Chill out, take a break, have a coffee." alert))
1344       (3 (emchat-log-error "Rate limit passed: %d
1345 Hope you get to read this before you get disconnected" discon))
1346       (4 #'ignore))))
1347
1348 (defun emchat-v8-snac-srv-pause (ectx data &optional flags)
1349   "SRV_SERVERPAUSE, SNAC(1, B)."
1350   ;; Send CLI_ACKSERVERPAUSE snac
1351   (emchat-v8-send ectx
1352     (emchat-v8-pack-snac ectx '(#x09 . #x02)
1353       (apply 'concat (mapcar #'(lambda (fam)
1354                                  (emchat-v8-pack-word (car fam)))
1355                              emchat-v8-snacv-list))))
1356
1357   ;; Mark ECTX as in pause, until SRV_MIGRATIONREQ is received
1358   (setf (emchat-v8-ctx-pause-p ectx) t))
1359
1360 (defun emchat-v8-snac-srv-migrate (ectx data &optional flags)
1361   "SRV_MIGRATIONREQ, SNAC(1, 12)."
1362   (let* ((tlvs (progn
1363                  (emchat-v8-fetch-word data)
1364                  (emchat-v8-fetch-tlvs data)))
1365          (tlv5 (emchat-v8-tlv-get tlvs 5))
1366          (tlv6 (emchat-v8-tlv-get tlvs 6)))
1367
1368     ;; Close current connection
1369     (emchat-v8-close ectx)
1370
1371     (let* ((nsrv (split-string (emchat-v8-tlv-str tlv5) ":"))
1372            (addr (nth 0 nsrv))
1373            (port (string-to-int (nth 1 nsrv))))
1374       (emchat-v8-debug "Migrating to new server: %s:%d" addr port)
1375       ;; Store cookie and reconnect
1376       (emchat-v8-ctx-put-prop ectx 'cli-cookie (emchat-v8-tlv-str tlv6))
1377       (emchat-v8-connect ectx addr port))))
1378
1379 (defun emchat-v8-snac-srv-motd (ectx data &optional flags)
1380   "SRV_MOTD, SNAC(1, 13)."
1381   (emchat-v8-debug "SRV_MOTD")
1382
1383   (emchat-v8-snac-cli-ratesrequest ectx)
1384   (emchat-v8-snac-cli-reqinfo ectx)
1385
1386   ;; TODO: roster
1387   (emchat-v8-snac-cli-reqlocation ectx)
1388   (emchat-v8-snac-cli-reqbuddy ectx)
1389   (emchat-v8-snac-cli-reqicbm ectx)
1390   (emchat-v8-snac-cli-reqbos ectx)
1391
1392   (emchat-v8-ctx-run-incoming-handler ectx 'connected))
1393
1394 (defconst emchat-v8-msg-types
1395   '((0 . automatic)                     ; An automatic message
1396     (1 . normal)                        ; A plain normal message
1397     (2 . chat-request)                  ; A chat request
1398     (3 . file-transfer-request)         ; A file transfer request
1399     (4 . url)                           ; An URL message. The message consists of the description and the url
1400     (6 . auth-request)                  ; An authorization request
1401     (7 . auth-reject)                   ; An authorization reject message
1402     (8 .  auth-accept)                  ; An authorization accept message
1403     (12 . added)                        ; You were added to the sender's contact list
1404     (13 . web-pager)                    ; A message sent through www.icq.com's web pager
1405     (14 . email-pager)                  ; A message sent through the email pager ([uin]@pager.icq.com)
1406     (19 . contact-list)                 ; A contact list message
1407     (26 . extended)                     ; An extended message. The packet will contain more data
1408     (1000 . get-away)                   ; A message requesting the "away" auto message
1409     (1001 . get-occ)                    ; A message requesting the "occupied" auto message
1410     (1002 . get-na)                     ; A message requesting the "not available" auto message
1411     (1003 . get-dnd)                    ; A message requesting the "do not disturb" auto message
1412     (1004 . get-ffc)                    ; A message requesting the "free for chat" auto message
1413     )
1414   "List of message types.")
1415
1416 (defconst emchat-v8-msg-mass-flag #x8000
1417   "If set, message was sent to several recipients.")
1418
1419 (defun emchat-v8-snac-srv-recv-msg (ectx data &optional flags)
1420   "SRV_RECVMSG, SNAC(4, 7)."
1421   (emchat-v8-debug "data here: %S" data)
1422   (let ((midtime (emchat-v8-fetch-time data))
1423         (midrand (emchat-v8-fetch-dword data))
1424         (type (emchat-v8-fetch-word data))
1425         (uin (emchat-v8-fetch-buin data))
1426         (warn (emchat-v8-fetch-word data))
1427         (count (emchat-v8-fetch-word data))
1428         (tlvs (emchat-v8-fetch-tlvs data)))
1429
1430     ;; Fetch tlvs
1431     (emchat-v8-debug "Got message from %S, mt/mr/t/w/c=%S/%S/%S/%S/%S, tlvs=%S"
1432                    uin midtime midrand type warn count tlvs)
1433
1434     (cond ((= type 1)
1435            ;; Normal message
1436            (let* ((tlvals (emchat-v8-fetch-tlvs
1437                            (emchat-v8-tlv-val (emchat-v8-tlv-get tlvs 2))))
1438                   (caps (emchat-v8-fetch-byte
1439                          (emchat-v8-tlv-val (emchat-v8-tlv-get tlvals 1281))))
1440                   (mtlval (emchat-v8-tlv-val
1441                            (emchat-v8-tlv-get tlvals 257)))
1442                   (menc (emchat-v8-fetch-word mtlval))
1443                   (msg (progn
1444                          (emchat-v8-fetch-word mtlval) ; skip
1445                          (emchat-v8-fetch-string mtlval))))
1446
1447              (emchat-v8-debug "Normal message: caps/menc=%d/%d, msg='%s'"
1448                             caps menc msg)
1449              (emchat-v8-ctx-run-incoming-handler ectx 'instant-message
1450                :uin uin :msg msg :msg-type 'normal)))
1451
1452           ((= type 2)
1453            ;; Advanced message
1454            ;; TODO: -write me
1455            (emchat-v8-debug "MSG[%d]: here" type))
1456
1457           ((= type 4)
1458            ;; Server message
1459            (let* ((tlv5 (emchat-v8-tlv-val (emchat-v8-tlv-get (nreverse tlvs) 5)))
1460                   (uin (truncate (emchat-v8-fetch-uin tlv5)))
1461                   (mtype (emchat-v8-fetch-word-le tlv5))
1462                   (msg (emchat-v8-fetch-lnts tlv5))
1463                   msg-type)
1464              ;; Adjust MTYPE to remove flag fields (MSGF_MASS)
1465              (setq mtype (logand mtype (lognot emchat-v8-msg-mass-flag)))
1466              (setq msg-type (cdr (assoc mtype emchat-v8-msg-types)))
1467
1468              (emchat-v8-ctx-run-incoming-handler ectx 'instant-message
1469                  :uin uin :msg msg :msg-type msg-type)))
1470
1471           (t (error "Unknown message type")))))
1472
1473 (defun emchat-v8-snac-srv-missed-icbm (ectx data &optional flags)
1474   "SRV_MISSED_ICBM, SNAC(4, 10)."
1475   (let* ((buin (progn
1476                  (emchat-v8-fetch-word data) ; skip channel
1477                  (emchat-v8-fetch-buin data)))
1478          (mmsgs (progn
1479                   (emchat-v8-fetch-word data) ; skip warn
1480                   (dotimes (n (emchat-v8-fetch-word data)) ; skip tlvs
1481                     (emchat-v8-fetch-single-tlv data))
1482                   (emchat-v8-fetch-word data)))
1483          (rn (emchat-v8-fetch-word data))
1484          (reasons '((0 . "Invalid message")
1485                     (1 . "Message too large")
1486                     (2 . "Message rate limit exceeded")
1487                     (3 . "Sender too evil (sender warn level > your max_msg_sevil)")
1488                     (4 . "You are too evil (sender max_msg_revil > your warn level)")))
1489          (reason (or (cdr (assq rn reasons)) "Unknown reason")))
1490     (emchat-v8-ctx-run-incoming-handler ectx 'missed-message
1491       :uin buin :missed-messages mmsgs :reason reason)))
1492
1493 (defun emchat-v8-snac-srv-contact-err (ectx data &optional flags)
1494   "SRV_CONTACTERR, SNAC(3, #x01)."
1495   (let* ((ercode (emchat-v8-fetch-word data))
1496          (errmsg (cond ((= ercode #x0E) "Empty UIN list sent")
1497                        ((= ercode #x14) "Non existant UIN")
1498                        ((= ercode #x15) "Contact list full"))))
1499     (emchat-v8-debug "[SRV_CONTACTERR]: Code=%d (0x%1$02X), Msg=%s" ercode errmsg)
1500     (emchat-v8-ctx-run-incoming-handler ectx 'srv-contacterr :reason errmsg)))
1501
1502 (defun emchat-v8-snac-srv-err (ectx data &optional flags)
1503   "SRV_GEN_ERR, SNAC(1, #x01)."
1504   (let* ((ercode (emchat-v8-fetch-word data))
1505          (errmsg (cond ((= ercode #x01) "Invalid SNAC header.")
1506                        ((= ercode #x02) "Server rate limit exceeded")
1507                        ((= ercode #x03) "Client rate limit exceeded")
1508                        ((= ercode #x04) "Recipient is not logged in")
1509                        ((= ercode #x05) "Requested service unavailable")
1510                        ((= ercode #x06) "Requested service not defined")
1511                        ((= ercode #x07) "You sent obsolete SNAC")
1512                        ((= ercode #x08) "Not supported by server")
1513                        ((= ercode #x09) "Not supported by client")
1514                        ((= ercode #x0A) "Refused by client")
1515                        ((= ercode #x0B) "Reply too big")
1516                        ((= ercode #x0C) "Responses lost")
1517                        ((= ercode #x0D) "Request denied")
1518                        ((= ercode #x0E) "Incorrect SNAC format")
1519                        ((= ercode #x0F) "Insufficient rights")
1520                        ((= ercode #x10) "In local permit/deny (recipient blocked)")
1521                        ((= ercode #x11) "Sender too evil")
1522                        ((= ercode #x12) "Receiver too evil")
1523                        ((= ercode #x13) "User temporarily unavailable")
1524                        ((= ercode #x14) "No match")
1525                        ((= ercode #x15) "List overflow")
1526                        ((= ercode #x16) "Request ambiguous")
1527                        ((= ercode #x17) "Server queue full")
1528                        ((= ercode #x18) "Not while on AOL")
1529                        (t "Unknown error"))))
1530     (emchat-v8-debug "SRV_GEN_ERR: %s" errmsg)
1531     (emchat-v8-ctx-run-incoming-handler ectx 'srv-error :reason errmsg)))
1532
1533 (defun emchat-v8-snac-srv-reply-bos (ectx data &optional flags)
1534   "SRV_REPLYBOS, SNAC(9, 3)."
1535   (emchat-v8-snac-cli-setuserinfo ectx)
1536   (emchat-v8-snac-cli-setstatus
1537    ectx (emchat-v8-ctx-get-prop ectx 'initial-status))
1538   (emchat-v8-snac-cli-ready ectx)
1539   ;; This is the now unsupported local-only type of contact list.
1540   ;; (emchat-v8-snac-cli-add-contact ectx)
1541   (emchat-v8-snac-cli-reqofflinemsgs ectx))
1542
1543 (defun emchat-v8-snac-srv-srv-ack-msg (ectx data &optional flags)
1544   "SRV_SRVACKMSG, SNAC (4 . #x0C)"
1545   (let ((type (progn
1546                 (emchat-v8-fetch-data data 8) ; skip
1547                 (emchat-v8-fetch-word data)))
1548         (buin (emchat-v8-fetch-buin data)))
1549     (emchat-v8-debug "SRVACKMSG: type=%d uin=%d" type buin)
1550     ))
1551
1552 ;;;; CLI
1553
1554 ;;; Family #x13 (SSI -- Server Side Info)
1555
1556 (defun emchat-v8-snac-cli-ssi-right-request (ectx)
1557   "Request rights/limitations for SSI. SNAC(#x13, #x02)."
1558   (emchat-v8-send ectx
1559     (emchat-v8-pack-snac ectx '(#x13 . #x02))))
1560
1561 (defun emchat-v8-snac-cli-ssi-request (ectx)
1562   "Request server side info.  SNAC(#x13, #x04)."
1563   (emchat-v8-send ectx
1564     (emchat-v8-pack-snac ectx '(#x13 . #x04))))
1565
1566 (defun emchat-v8-snac-cli-ssi-checkout (ectx)
1567   "Checkout SSI list if local copy is out of date.  SNAC(#x13, #x05)."
1568   (let ((num (emchat-world-ssi-count))
1569         (modt (emchat-world-ssi-mod-time)))
1570     (emchat-v8-send ectx
1571       (emchat-v8-pack-snac ectx '(#x13 . #x05)
1572         (emchat-v8-pack-time modt)
1573         (emchat-v8-pack-word num)))))
1574
1575 (defun emchat-v8-snac-cli-ssi-activate (ectx)
1576   "Activate SSI.  SNAC(#x13, #x07)."
1577   (emchat-v8-send ectx
1578     (emchat-v8-pack-snac ectx '(#x13 . #x07))))
1579
1580 ;;; FIXME:  This isn't working.
1581 (defun emchat-v8-snac-cli-ssi-add (ectx uin grp id nick)
1582   "Add contacts to SSI.  SNAC(#x13, #x08)."
1583   (emchat-v8-send ectx
1584     (emchat-v8-pack-snac ectx '(#x13 . #x08)
1585       (emchat-v8-pack-bstr uin)
1586       (emchat-v8-pack-word grp)
1587       (emchat-v8-pack-word id)
1588       (emchat-v8-pack-word #x0000)
1589       (emchat-v8-pack-tlv #x0131 nick))))
1590
1591 ;;; FIXME: Write me
1592 (defalias 'emchat-v8-snac-cli-ssi-update #'ignore)
1593 ;; (defun emchat-v8-snac-cli-ssi-update (ectx &rest entries)
1594 ;;   "Update existing SSI entries.  SNAC(#x13, #x09)."
1595 ;;   (emchat-v8-debug "CLI_SSI_UPDATE: somebody impliment me"))
1596
1597 ;;; FIXME: Write me
1598 (defalias 'emchat-v8-snac-cli-ssi-delete #'ignore)
1599 ;; (defun emchat-v8-snac-cli-ssi-delete (ectx &rest entries)
1600 ;;   "Delete existing SSI entries.  SNAC(#x13, #x0A)."
1601 ;;   (emchat-v8-debug "CLI_SSI_DELETE: somebody impliment me"))
1602 (defalias 'emchat-v8-snac-cli-ssi-edit-begin #'ignore)
1603 ;; (defun emchat-v8-snac-cli-ssi-edit-begin (ectx &rest args)
1604 ;;   "Begin SSI edits.  SNAC(#x13, #x11)."
1605 ;;   (emchat-v8-send ectx
1606 ;;     (emchat-v8-pack-snac ectx '(#x13 . #x11))))
1607 (defalias 'emchat-v8-snac-cli-ssi-edit-end #'ignore)
1608 ;; (defun emchat-v8-snac-cli-ssi-edit-end (ectx &rest args)
1609 ;;   "End SSI edits.  SNAC(#x13, #x12)."
1610 ;;   (emchat-v8-send ectx
1611 ;;     (emchat-v8-pack-snac ectx '(#x13 . #x12))))
1612
1613 (defun emchat-v8-snac-cli-ssi-future-auth-grant (ectx uin reason)
1614   "Give future auth grant.  SNAC(#x13, #x14)."
1615   (emchat-v8-send ectx
1616     (emchat-v8-pack-snac ectx '(#x13 . #x14)
1617       (emchat-v8-pack-byte (length (number-to-string uin)))
1618       (emchat-v8-pack-buin uin)
1619       (emchat-v8-pack-dword 0))))
1620
1621 (defun emchat-v8-snac-cli-ssi-del-yourself (ectx uin)
1622   "Delete yourself from someone's contact list.  SNAC(#x13, #x16)."
1623   (emchat-v8-send ectx
1624     (emchat-v8-pack-snac ectx '(#x13 . #x16)
1625       (emchat-v8-pack-buin uin))))
1626
1627 (defun emchat-v8-snac-cli-ssi-send-auth-request (ectx uin msg)
1628   "Send auth request.  SNAC(#x13, #x18)."
1629   (emchat-v8-send ectx
1630     (emchat-v8-pack-snac ectx '(#x13 . #x18)
1631       (emchat-v8-pack-buin uin)
1632       (emchat-v8-pack-bstr msg))))
1633
1634 (defun emchat-v8-snac-cli-ssi-auth-reply (ectx uin reply &optional reason)
1635   "Reply to auth-request.  SNAC(#x13, #x1A)."
1636   (emchat-v8-send ectx
1637     (emchat-v8-pack-snac ectx '(#x13 . #x1A)
1638       (emchat-v8-pack-buin uin)
1639       (emchat-v8-pack-byte reply)
1640       (emchat-v8-pack-bstr reason)
1641       (emchat-v8-pack-word 0))))
1642
1643
1644 (defun emchat-v8-snac-cli-setuserinfo (ectx)
1645   "Send userinfo."
1646   )
1647
1648 (defconst emchat-v8-status-alist
1649   `((offline . ,(* 256.0 256 256 256))
1650     (invisible . #x100)                 ;user is invisible
1651     (dnd . #x02)                        ;user does not want to be disturbed
1652     (occupied . #x10)                   ;user is occupied
1653     (na . #x04)                         ;user not available
1654     (away . #x01)                       ;user is away
1655     (ffc . #x20)                        ;user is free for chat
1656     (online . #x00)                     ;user is online
1657     (set-invisible . #x100)
1658     (set-dnd . #x13)
1659     (set-occupied . #x11)
1660     (set-na . #x05)
1661     (set-away . #x01)
1662     (set-ffc . #x20)
1663     (web-aware . #x010000)
1664     (allow-ip . #x020000)
1665     (birthday . #x80000)
1666     (dcauth . #x10000000)
1667     (dccontact . #x20000000))
1668   "Alist of states.")
1669
1670 (defun emchat-v8-find-status (num)
1671   "Find statu by NUM."
1672   (setq num (logand num #x0000ffff))
1673   (let ((statuses (cdr emchat-v8-status-alist)))
1674     (while (and statuses
1675                 (zerop (logand num (cdar statuses))))
1676       (setq statuses (cdr statuses)))
1677     (or (caar statuses) 'online)))
1678
1679 (defun emchat-v8-snac-cli-setstatus (ectx &optional status)
1680   "Set status, SNAC(1, 30)."
1681   (setq status (apply 'logior
1682                       (mapcar #'(lambda (st)
1683                                   (cdr (assoc st emchat-v8-status-alist)))
1684                               status)))
1685
1686   (emchat-v8-send ectx
1687     (emchat-v8-pack-snac ectx '(#x01 . #x1E)
1688       (emchat-v8-pack-tlv 6
1689         (emchat-v8-pack-dword status))
1690       (emchat-v8-pack-tlv 8
1691         (emchat-v8-pack-word 0)))))
1692
1693 (defun emchat-v8-snac-cli-add-contact (ectx &optional contacts)
1694   "CLI_ADDCONTACT, SNAC(3,4)
1695 Send either CONTACTS or ECTX's contact list."
1696   (unless contacts
1697     (setq contacts (emchat-v8-ctx-get-prop ectx 'contacts)))
1698   (emchat-v8-debug "Adding contacts: %S" contacts)
1699   (when contacts
1700     (emchat-v8-send ectx
1701       (emchat-v8-pack-snac ectx '(#x03 . #x04)
1702         (emchat-v8-pack-uinlist contacts)))))
1703
1704 (defun emchat-v8-snac-cli-addvisible (ectx &optional uin-list)
1705   "CLI_ADDVISIBLE SNAC(9, 5)."
1706   (unless uin-list
1707     (setq uin-list (emchat-v8-ctx-get-prop ectx 'visible-list)))
1708   (emchat-v8-debug "Adding to visible: %S" uin-list)
1709   (when uin-list
1710     (emchat-v8-send ectx
1711       (emchat-v8-pack-snac ectx '(#x09 . #x05)
1712         (emchat-v8-pack-uinlist uin-list)))))
1713
1714 (defun emchat-v8-snac-cli-remvisible (ectx uin-list)
1715   "CLI_ADDVISIBLE SNAC(9, 6)."
1716   (emchat-v8-debug "Removing from visible: %S" uin-list)
1717   (when uin-list
1718     (emchat-v8-send ectx
1719       (emchat-v8-pack-snac ectx '(#x09 . #x06)
1720         (emchat-v8-pack-uinlist uin-list)))))
1721
1722 (defun emchat-v8-snac-cli-addinvisible (ectx &optional uin-list)
1723   "CLI_ADDVISIBLE SNAC(9, 7)."
1724   (unless uin-list
1725     (setq uin-list (emchat-v8-ctx-get-prop ectx 'invisible-list)))
1726   (emchat-v8-debug "Adding to invisible: %S" uin-list)
1727   (when uin-list
1728     (emchat-v8-send ectx
1729       (emchat-v8-pack-snac ectx '(#x09 . #x07)
1730         (emchat-v8-pack-uinlist uin-list)))))
1731
1732 (defun emchat-v8-snac-cli-reminvisible (ectx uin-list)
1733   "CLI_REMINVISIBLE SNAC(9, 8)."
1734   (emchat-v8-debug "Removing from invisible: %S" uin-list)
1735   (when uin-list
1736     (emchat-v8-send ectx
1737       (emchat-v8-pack-snac ectx '(#x09 . #x08)
1738         (emchat-v8-pack-uinlist uin-list)))))
1739
1740 (defun emchat-v8-snac-cli-keepalive (ectx)
1741   "Send keep-alive flap."
1742   (emchat-v8-send ectx
1743     (emchat-v8-pack-flap ectx 5)))
1744
1745 (defun emchat-v8-pack-meta-snac (ectx sub &optional type &rest data)
1746   "Create meta snac."
1747   (setq data (apply 'concat data))
1748
1749   (let ((seq3 (emchat-v8-ctx-get-prop ectx 'our-seq3))
1750         temp-data)
1751     (if seq3
1752         (emchat-v8-ctx-put-prop ectx 'our-seq3 (% (1+ seq3) 32767))
1753       (emchat-v8-ctx-put-prop ectx 'our-seq3 2))
1754
1755     (setq temp-data
1756           (concat
1757            (emchat-v8-pack-uin (plist-get (emchat-v8-ctx-userinfo ectx) 'uin))
1758            (emchat-v8-number->string-swap 2 sub)
1759            (emchat-v8-number->string-swap 2 (emchat-v8-ctx-get-prop ectx 'our-seq3))
1760            (when type
1761              (emchat-v8-number->string-swap 2 type))
1762            data))
1763
1764     (emchat-v8-pack-snac ectx '(#x15 . #x02)
1765       (emchat-v8-pack-tlv 1
1766         (emchat-v8-number->string-swap 2 (length temp-data))
1767         temp-data))))
1768
1769 (defun emchat-v8-snac-cli-reqofflinemsgs (ectx)
1770   "CLI_REQOFFLINEMSGS, SNAC(15,2)."
1771   (emchat-v8-send ectx
1772     (emchat-v8-pack-meta-snac ectx 60)))
1773
1774 (defun emchat-v8-snac-cli-metareqinfo (ectx uin)
1775   "CLI_METAREQINFO, SNAC(15,2)/2000/1232."
1776   (emchat-v8-send ectx
1777     (emchat-v8-pack-meta-snac ectx 2000 1232
1778        (emchat-v8-pack-uin uin)))
1779
1780   ;; Save pair SEQ/UIN for later UIN extraction
1781   (emchat-v8-ctx-put-prop ectx 'about-query-seq-uin
1782     (cons (cons (emchat-v8-ctx-get-prop ectx 'our-seq3) uin)
1783           (emchat-v8-ctx-get-prop ectx 'about-query-seq-uin))))
1784
1785 (defun emchat-v8-snac-cli-searchbyuin (ectx uin)
1786   "CLI_SEARCHBYUIN, SNAC(15,2)/2000/1385."
1787   (emchat-v8-send ectx
1788     (emchat-v8-pack-meta-snac ectx 2000 1385
1789        (emchat-v8-pack-word-le 310)       ; Search key (310 == uin)
1790        (emchat-v8-pack-lnts (emchat-v8-pack-uin uin)))))
1791
1792 (defun emchat-v8-snac-cli-searchbyemail (ectx email)
1793   "CLI_SEARCHBYEMAIL, SNAC(15,2)/2000/1395."
1794   (emchat-v8-send ectx
1795     (emchat-v8-pack-meta-snac
1796      ectx 2000 1395
1797      (emchat-v8-pack-word-le 350)               ; Search key (350 == email)
1798      (emchat-v8-pack-llnts email))))
1799
1800 (defun emchat-v8-snac-cli-searchbypersinf (ectx first last nick email online)
1801   "CLI_SEARCHBYPERSINF, SNAC(15,2)/2000/1375."
1802   (emchat-v8-send ectx
1803     (emchat-v8-pack-meta-snac
1804      ectx 2000 1375
1805      (emchat-v8-pack-word-le 320)       ; Search key (320 == first name)
1806      (emchat-v8-pack-llnts first)
1807      (emchat-v8-pack-word-le 330)       ; Search key (330 == last name)
1808      (emchat-v8-pack-llnts last)
1809      (emchat-v8-pack-word-le 340)       ; Search key (340 == nick name)
1810      (emchat-v8-pack-llnts nick)
1811      (emchat-v8-pack-word-le 350)       ; Search key (350 == email)
1812      (emchat-v8-pack-llnts email)
1813      (emchat-v8-pack-byte online))))
1814
1815 ;;; FIXME: this doesn't impliment direct connect or something called
1816 ;;; "user kind"
1817 (defun emchat-v8-snac-cli-metasetsecurity (ectx auth web)
1818   "CLI_METASETSECURITY. SNAC(#x15, #x02)/2000/1060."
1819   (emchat-v8-send ectx
1820     (emchat-v8-pack-meta-snac
1821      ectx 2000 1060
1822      (emchat-v8-pack-byte auth)         ; req auth 0 = no; 1 = yes
1823      (emchat-v8-pack-byte web)          ; webaware 0 = yes; 1 = no
1824      (emchat-v8-pack-byte #x02)         ; dc hard coded to only with auth
1825      (emchat-v8-pack-byte 0))))         ; user kind (no idea, set to zero)
1826
1827 (defun emchat-v8-snac-cli-ready (ectx)
1828   "CLI_READY, SNAC(1, 2)."
1829   (emchat-v8-send ectx
1830     (emchat-v8-pack-snac ectx '(#x01 . #x02)
1831       (apply 'concat
1832              (mapcar #'(lambda (sn)
1833                          (concat
1834                           (emchat-v8-pack-word (car sn))
1835                           (emchat-v8-pack-word (cdr sn))
1836                           (if (= (car sn) 2)
1837                               (emchat-v8-pack-dword #x0101047B)
1838                             (emchat-v8-pack-dword #x0110047B))))
1839                      emchat-v8-snacv-list)))))
1840
1841 (defun emchat-v8-snac-cli-families (ectx)
1842   "CLI_FAMILIES, SNAC(1, 17)."
1843   (emchat-v8-send ectx
1844     (emchat-v8-pack-snac ectx '(#x01 . #x17)
1845       (apply 'concat
1846              (mapcar #'(lambda (sn)
1847                          (concat
1848                           (emchat-v8-pack-word (car sn))
1849                           (emchat-v8-pack-word (cdr sn))))
1850                      emchat-v8-snacv-list)))))
1851
1852 (defun emchat-v8-snac-cli-ratesrequest (ectx)
1853   "CLI_RATESREQUEST, SNAC(1, 6)."
1854   (emchat-v8-send ectx
1855     (emchat-v8-pack-snac ectx '(#x01 . #x06))))
1856
1857 (defun emchat-v8-snac-cli-reqinfo (ectx)
1858   "CLI_REQINFO, SNAC(1, E)."
1859   (emchat-v8-send ectx
1860     (emchat-v8-pack-snac ectx '(#x01 . #x0E))))
1861
1862 (defun emchat-v8-snac-cli-reqlocation (ectx)
1863   "CLI_REQLOCATION, SNAC(2, 2)."
1864   (emchat-v8-send ectx
1865     (emchat-v8-pack-snac ectx '(#x02 . #x02))))
1866
1867 (defun emchat-v8-snac-cli-reqbuddy (ectx)
1868   "CLI_REQBUDDY, SNAC(3, 2)."
1869   (emchat-v8-send ectx
1870     (emchat-v8-pack-snac ectx '(#x03 . #x02))))
1871
1872 (defun emchat-v8-snac-cli-reqicbm (ectx)
1873   "CLI_REQICBM, SNAC(4, 4)."
1874   (emchat-v8-send ectx
1875     (emchat-v8-pack-snac ectx '(#x04 . #x04))))
1876
1877 (defun emchat-v8-snac-cli-sendmsg (ectx uin format msg)
1878   "CLI_SENDMSG, SNAC(4, 6).
1879 UIN - Icq uin to send message to.
1880 FORMAT - format id, 1 - simple, 2 - advanced, 4 - typed.
1881 MSG - Message itself."
1882   (emchat-v8-send ectx
1883     (emchat-v8-pack-snac ectx '(#x04 . #x06)
1884       (emchat-v8-pack-dword 0)            ; random
1885       (emchat-v8-pack-dword 0)            ; random
1886       (emchat-v8-pack-word format)
1887       (emchat-v8-pack-buin uin)
1888       msg
1889       (emchat-v8-pack-tlv 6))))
1890
1891 (defconst emchat-v8-msg-encodings
1892   '((us-ascii . 0)
1893     (utf-16 . 2)
1894     (8bit . 3)))
1895
1896 (defun emchat-v8-send-simple-message (ectx uin message)
1897   "Send simple message."
1898   (emchat-v8-snac-cli-sendmsg ectx uin 1
1899     (emchat-v8-pack-tlv 2
1900       (emchat-v8-pack-tlv 1281 (emchat-v8-pack-byte 1))
1901       (emchat-v8-pack-tlv 257
1902         (emchat-v8-pack-word 3)
1903         (emchat-v8-pack-word (+ 4 (length message)))
1904         message))))
1905
1906 (defun emchat-v8-send-typed-message (ectx uin type message)
1907   "Send typed message."
1908   (emchat-v8-snac-cli-sendmsg ectx uin 4
1909     (emchat-v8-pack-tlv 5
1910       (emchat-v8-pack-uin (plist-get (emchat-v8-ctx-userinfo ectx) 'uin))
1911       (emchat-v8-pack-word-le
1912        (car (find type emchat-v8-msg-types :key 'cdr :test 'eq)))
1913       (emchat-v8-pack-lnts message))))
1914
1915 (defun emchat-v8-send-advanced-message (ectx uin &rest add-arguments-here-for-advanced-message)
1916   ;; Advanced message:
1917   ;; TLV(5):
1918   ;;    2 ACKTYPE :  0 - normal, 1 - abort, 2 - file ack
1919   ;;    4 TIME : copy
1920   ;;    4 ID : random id
1921   ;;  TLV(11) UNKNOWN : Only if ACTYPE is 1
1922   ;;   CAP
1923   ;;  TLV(10) ACKTYPE2 : 1 - normal, 2 - file ack
1924   ;;  TLV(5) PORT
1925   ;;  TLV(3) IP
1926   ;;  TLV15  UNKNOWN
1927   ;;  TLV(1001) MESSAGE
1928 ;  (emchat-v8-snac-cli-sendmsg ectx uin 2)
1929   (emchat-v8-debug "TODO: `emchat-v8-send-advanced-message'")
1930   )
1931
1932 (defun emchat-v8-send-server-message (ectx uin &rest add-arguments-here-for-server-message)
1933   ;; Server message:
1934   ;; TLV(5)
1935   ;;   4  UIN  : sender uin
1936   ;;   2  MSGTYPE : message type
1937   ;; LNTS MSG : message with unspecified encoding
1938 ;  (emchat-v8-snac-cli-sendmsg ectx uin 3)
1939   (emchat-v8-debug "TODO: `emchat-v8-send-advanced-message'")
1940   )
1941
1942 (defun emchat-v8-snac-cli-reqbos (ectx)
1943   "CLI_REQBOS, SNAC(9, 2)."
1944   (emchat-v8-send ectx
1945     (emchat-v8-pack-snac ectx '(#x09 . #x02))))
1946
1947 (defun emchat-v8-handle-flap (ectx-flap)
1948   (let* ((ectx (car ectx-flap))
1949          (flap (cdr ectx-flap))
1950          (cid (emchat-v8-flap-cid flap)))
1951     (cond ((= cid emchat-v8-FLAP-HELLO)
1952            ;; XXX Login channel
1953            (emchat-v8-debug "Got HELLO cid")
1954            (let ((cmd (emchat-v8-fetch-dword (emchat-v8-flap-data flap)))
1955                  (cli-cook (emchat-v8-ctx-get-prop ectx 'cli-cookie)))
1956              (cond ((= cmd 1)
1957                     (if cli-cook
1958                         ;; Already logged in, send Cookie
1959                         (emchat-v8-send ectx
1960                           (emchat-v8-pack-flap ectx emchat-v8-FLAP-HELLO
1961                             (emchat-v8-pack-dword 1)
1962                             (emchat-v8-pack-tlv 6 cli-cook)))
1963
1964                       ;; Not logged in yet
1965                       (emchat-v8-login ectx)))
1966
1967                    (t (error (format "Unknown FLAP CMD(%) in login channel." cmd))))
1968              ))
1969
1970           ((= cid emchat-v8-FLAP-SNAC)
1971            ;; SNAC channel
1972            ;; TODO:
1973            ;;  - Write me
1974            (let ((snac (emchat-v8-fetch-snac (emchat-v8-flap-data flap)))
1975                  (snacs emchat-v8-snac-list))
1976              (while (and snacs
1977                          (or (not (= (emchat-v8-snac-family snac)
1978                                      (car (caar snacs))))
1979                              (not (= (emchat-v8-snac-subtype snac)
1980                                      (cdr (caar snacs))))))
1981                (setq snacs (cdr snacs)))
1982
1983              (emchat-v8-debug "SNAC %S (%S)" snac (when (car snacs) (nth 1 (car snacs))))
1984
1985              (unless snacs
1986                (error 'invalid-argument "Unknown SNAC" snac))
1987
1988              ;; Call snac handler
1989              (funcall (nth 2 (car snacs))
1990                       ectx                           ; context
1991                       (emchat-v8-flap-data flap)     ; data
1992                       (emchat-v8-snac-flags snac)))) ; snac flags
1993
1994           ((= cid emchat-v8-FLAP-ERRORS)
1995            ;; ERRORS channel
1996            (emchat-v8-debug "ERROR")
1997            )
1998
1999           ((= cid emchat-v8-FLAP-LOGOFF)
2000            ;; LOGOFF channel
2001            (let* ((tlvs (emchat-v8-fetch-tlvs (emchat-v8-flap-data flap)))
2002                   (tlv (emchat-v8-tlv-get tlvs 5)))
2003
2004              (emchat-v8-debug "LOGOFF tlv_t5=%S" tlv)
2005              ;; Close connection
2006              (emchat-v8-close ectx)
2007
2008              (if (not tlv)
2009                  ;; Another user with same UIN
2010                  (emchat-v8-ctx-run-incoming-handler ectx 'logoff)
2011
2012                ;; Redirected
2013                (let* ((nsrv (split-string (emchat-v8-tlv-str tlv) ":"))
2014                       (addr (nth 0 nsrv))
2015                       (port (string-to-int (nth 1 nsrv))))
2016                  (emchat-v8-debug "Redirected to new server: %s:%d" addr port)
2017                  ;; Store cookie and reconnect
2018                  (emchat-v8-ctx-put-prop ectx 'cli-cookie
2019                    (emchat-v8-tlv-str (emchat-v8-tlv-get tlvs 6)))
2020                  (emchat-v8-connect ectx addr port)))))
2021
2022           ((= cid emchat-v8-FLAP-PING)
2023            ;; PING channel
2024            (emchat-v8-debug "PING")
2025            )
2026
2027           (t (error (format "Unknown FLAP cid(%d)." cid))))
2028     ))
2029
2030 (defun emchat-v8-fetch-handle-flaps (ectx)
2031   (while (> (length (emchat-v8-ctx-incoming-buffer ectx)) 0)
2032     ;; Do not do anything in filter function
2033     (emchat-v8-handle-flap (cons ectx (emchat-v8-fetch-flap ectx)))))
2034
2035 \f
2036 (defun emchat-v8-number->string (size val)
2037   "Convert number value VAL to string of SIZE."
2038   (cond ((= size 1)
2039          (setq val (truncate val))
2040          (char-to-string val))
2041         ((= size 2)
2042          (setq val (truncate val))
2043          (concat (char-to-string (ash (mod val 65536) -8))
2044                  (char-to-string (logand val 255))
2045                  ))
2046         ((= size 4)
2047          ;; XXX remove this
2048          (setq val (truncate val))
2049          (mapconcat 'identity
2050                     (nreverse
2051                      (list (char-to-string (int-to-char (% val 256)))
2052                            (char-to-string (int-to-char (% (setq val (/ val 256)) 256)))
2053                            (char-to-string (int-to-char (% (setq val (/ val 256)) 256)))
2054                            (char-to-string (int-to-char (% (setq val (/ val 256)) 256)))
2055                            ))
2056                     ""))
2057
2058         (t (error "Invalid SIZE" size))))
2059
2060 (defun emchat-v8-number->string-swap (size val)
2061   "Convert number VAL to string of SIZE."
2062   (let ((ss (emchat-v8-number->string size val))
2063         tt)
2064     (cond ((= size 2)
2065            (setq tt (aref ss 0))
2066            (aset ss 0 (aref ss 1))
2067            (aset ss 1 tt))
2068           ((= size 4)
2069            (setq tt (aref ss 0))
2070            (aset ss 0 (aref ss 3))
2071            (aset ss 3 tt)
2072            (setq tt (aref ss 1))
2073            (aset ss 1 (aref ss 2))
2074            (aset ss 2 tt)))
2075     ss))
2076
2077 (defun emchat-v8-create-message (&rest UNIPREFIX-message-spec)
2078   "Create emchat message according to SPEC."
2079   (let (UNIPREFIX-value-spec UNIPREFIX-value)
2080     (mapconcat (lambda (UNIPREFIX-element)
2081                  (setq UNIPREFIX-value-spec (eval (aref UNIPREFIX-element 0)))
2082                  (setq UNIPREFIX-value (eval (aref UNIPREFIX-element 1)))
2083
2084                  (cond ((numberp UNIPREFIX-value)
2085                         (emchat-v8-number->string UNIPREFIX-value-spec UNIPREFIX-value))
2086                        ((stringp UNIPREFIX-value)
2087                         (substring  UNIPREFIX-value 0 UNIPREFIX-value-spec))
2088                        ((null UNIPREFIX-value)
2089                         (make-string UNIPREFIX-value-spec ?\x00))
2090                        (t (error "Invalid SPEC" UNIPREFIX-value-spec))))
2091                UNIPREFIX-message-spec "")
2092     ))
2093
2094 (defun emchat-v8-string->number-le-flt (str &optional len)
2095   "Convert STR to number."
2096   (unless len
2097     (setq len (length str)))
2098
2099   (let ((ret 0.0) (i 0))
2100     (while (< i len)
2101       (setq ret (+ ret (* (char-int (aref str i)) (expt 256.0 i)))
2102             i (1+ i)))
2103     ret))
2104
2105 (defun emchat-v8-string->number-flt (str &optional len)
2106   "Convert STR to number."
2107   (unless len
2108     (setq len (length str)))
2109
2110   (let ((ret 0.0) (i 0))
2111     (while (< i len)
2112       (setq ret (+ (* 256.0 ret) (char-int (aref str i)))
2113             i (1+ i)))
2114     ret))
2115
2116 (defun emchat-v8-string->number-le-bigz (str &optional len)
2117   "Convert STR to number."
2118   ;; optimise for common cases
2119   (cond ((eq len 4)
2120          (+ (* (aref str 3) 16777216)
2121             (* (aref str 2) 65536)
2122             (* (aref str 1) 256)
2123             (aref str 0)))
2124         ((eq len 2)
2125          (+ (* (aref str 1) 256)
2126             (aref str 0)))
2127         ((eq len 1)
2128          (char-to-int (aref str 0)))
2129         (t
2130          (let* ((len (or len (length str)))
2131                 (ret (char-int (aref str 0)))
2132                 (i 1))
2133            (while (< i len)
2134              (setq ret (+ ret (* (char-int (aref str i))
2135                                  (2^ (* 8 i))))
2136                    i (1+ i)))
2137            ret))))
2138
2139 (defun emchat-v8-string->number-bigz (str &optional len)
2140   "Convert STR to number."
2141   ;; optimise for common cases
2142   (cond ((eq len 4)
2143          (+ (* (aref str 0) 16777216)
2144             (* (aref str 1) 65536)
2145             (* (aref str 2) 256)
2146             (aref str 3)))
2147         ((eq len 2)
2148          (+ (* (aref str 0) 256)
2149             (aref str 1)))
2150         ((eq len 1)
2151          (char-to-int (aref str 0)))
2152         (t
2153          (let* ((len (or len (length str)))
2154                 (ret 0)
2155                 (i 0))
2156            (while (< i len)
2157              (setq ret (+ (lsh ret 8) (char-int (aref str i)))
2158                    i (1+ i)))
2159            ret))))
2160
2161 ;; do the right thing at the right time, the wrong otherwise
2162 (cond
2163  ((featurep 'bigz)
2164   (defalias #'emchat-v8-string->number #'emchat-v8-string->number-bigz)
2165   (defalias #'emchat-v8-string->number-le #'emchat-v8-string->number-le-bigz)
2166   'using-bigz)
2167  (t
2168   (defalias #'emchat-v8-string->number #'emchat-v8-string->number-flt)
2169   (defalias #'emchat-v8-string->number-le #'emchat-v8-string->number-le-flt)
2170   'using-flt))
2171
2172 (defvar emchat-v8-timeout 15
2173   "Receive timeout in seconds.")
2174
2175 (defun emchat-v8-grab-bytes (ectx len)
2176   "Grab LEN bytes from ECTX's incoming buffer."
2177   (setq len (truncate len))             ;for sure
2178
2179   (let (rstr)
2180     (while (< (length (emchat-v8-ctx-incoming-buffer ectx)) len)
2181       (when (null (accept-process-output (emchat-v8-ctx-proc ectx)
2182                                          emchat-v8-timeout))
2183         (error "EMCHAT: Timeout")))
2184     (setq rstr (substring (emchat-v8-ctx-incoming-buffer ectx) 0 len))
2185     (setf (emchat-v8-ctx-incoming-buffer ectx)
2186           (substring (emchat-v8-ctx-incoming-buffer ectx) len))
2187     rstr))
2188
2189 (defun emchat-v8-grab-bytes-1 (vmsg len)
2190   "Grab LEN bytes from VMSG."
2191   (setq len (truncate len))
2192
2193   (let (rstr)
2194     ;; Check LEN
2195     (when (> len (length (aref vmsg 0)))
2196       (error 'invalid-argument "Invalid len" len))
2197
2198     (setq rstr (substring (aref vmsg 0) 0 len))
2199     (aset vmsg 0 (substring (aref vmsg 0) len))
2200     rstr))
2201
2202 ;; Generic length storers
2203 (defvar emchat-v8-length-1 nil)
2204 (defvar emchat-v8-length-2 nil)
2205 (defvar emchat-v8-length-3 nil)
2206 (defvar emchat-v8-length-4 nil)
2207
2208 (defun emchat-v8-parse-message (ectx-msg spec)
2209   "Parse ECTX-MSG according to SPEC.
2210 ECTX-MSG is either EMchat context to grab bytes from, or string.
2211
2212 SPEC is one of
2213  - Vector         specifies one value.
2214  - List           specifies multiple values.
2215  - List of Lists  specifies list of lists of multiple values."
2216   (when (stringp ectx-msg)
2217     (setq ectx-msg (vector ectx-msg)))
2218
2219   (let ((accessor (if (emchat-v8-ctx-p ectx-msg) 'emchat-v8-grab-bytes 'emchat-v8-grab-bytes-1))
2220         vlen vtype rlist)
2221
2222     (cond ((vectorp spec)
2223            ;; Vector
2224            (setq vlen (truncate (eval (aref spec 0))))
2225            (setq vtype (aref spec 1))
2226            (if (numberp vtype)
2227                (when (not (= (emchat-v8-string->number (funcall accessor ectx-msg vlen) vlen)
2228                              vtype))
2229                  (error 'invalid-argument "Invalid argument in MSG"))
2230
2231              ;; Normal type
2232              (cond ((or (eq vtype 'number) (eq vtype 'integer))
2233                     (setq rlist (emchat-v8-string->number (funcall accessor ectx-msg vlen) vlen)))
2234
2235                    ((or (eq vtype 'number-swap) (eq vtype 'integer-swap))
2236                     (setq rlist (emchat-v8-string->number-le (funcall accessor ectx-msg vlen) vlen)))
2237
2238                    ((eq vtype 'string)
2239                     (setq rlist (funcall accessor ectx-msg vlen)))
2240
2241                    ((and (symbolp vtype) (not (keywordp vtype))
2242                          (member vtype '(emchat-v8-length-1 emchat-v8-length-2 emchat-v8-length-3 emchat-v8-length-4)))
2243                     ;; If symbol - set it
2244                     (set vtype (emchat-v8-string->number (funcall accessor ectx-msg vlen) vlen))
2245                     (setq rlist (symbol-value vtype)))
2246
2247                    ((listp vtype)
2248                     (setq rlist (mapcar #'(lambda (not-used)
2249                                             (emchat-v8-parse-message ectx-msg vtype))
2250                                         (make-list vlen nil))))
2251
2252                    ((null vtype) ;; Skip
2253                     )
2254
2255                    (t (error 'invalid-argument "Invalid type in SPEC" vtype)))))
2256
2257           ((and (listp spec)
2258                 (not (member nil (mapcar (lambda (l) (listp l)) spec))))
2259            ;; List of Lists
2260            )
2261
2262           ((listp spec)
2263            ;; List
2264            (setq rlist (mapcar (lambda (e) (emchat-v8-parse-message ectx-msg e)) spec)))
2265
2266           (t (error 'invalid-argument "Invalid SPEC" spec)))
2267
2268     rlist))
2269
2270
2271 (put 'emchat-v8-parse-message 'lisp-indent-function 1)
2272
2273 (defun emchat-v8-fetch-data (data len)
2274   (vector (funcall (if (emchat-v8-ctx-p data)
2275                        'emchat-v8-grab-bytes
2276                      'emchat-v8-grab-bytes-1)
2277                    data len)))
2278
2279 (defun emchat-v8-fetch-string (data &optional len)
2280   (aref (emchat-v8-fetch-data data (or len (length (aref data 0)))) 0))
2281
2282 (defun emchat-v8-fetch-byte (data)
2283   (char-to-int (string-to-char (emchat-v8-fetch-string data 1))))
2284 (defun emchat-v8-pack-byte (byte)
2285   (char-to-string byte))
2286
2287 (defun emchat-v8-fetch-word (data)
2288   (truncate (emchat-v8-string->number
2289              (emchat-v8-fetch-string data 2))))
2290 (defun emchat-v8-pack-word (word)
2291   (emchat-v8-number->string 2 word))
2292
2293 (defun emchat-v8-fetch-word-le (data)
2294   (truncate (emchat-v8-string->number-le
2295              (emchat-v8-fetch-string data 2))))
2296 (defun emchat-v8-pack-word-le (word)
2297   (emchat-v8-number->string-swap 2 word))
2298
2299 (defun emchat-v8-fetch-dword (data)
2300   (emchat-v8-string->number
2301    (emchat-v8-fetch-string data 4)))
2302 (defun emchat-v8-pack-dword (dword)
2303   (emchat-v8-number->string 4 dword))
2304
2305 (defun emchat-v8-fetch-time (data)
2306   (cons (emchat-v8-fetch-word data)
2307         (emchat-v8-fetch-word data)))
2308
2309 (defun emchat-v8-pack-time (time)
2310   (concat
2311    (emchat-v8-pack-word (car time))
2312    (emchat-v8-pack-word (cdr time))))
2313
2314 (defun emchat-v8-fetch-uin (data)
2315   (truncate
2316    (emchat-v8-string->number-le
2317     (emchat-v8-fetch-string data 4))))
2318
2319 (defun emchat-v8-fetch-uinlist (count uinlist)
2320   (let (result)
2321     (dotimes (i count)
2322       (append (emchat-v8-fetch-uin uinlist) result))))
2323
2324 (defun emchat-v8-pack-uin (uin)
2325   (emchat-v8-number->string-swap 4 uin))
2326
2327 (defun emchat-v8-fetch-buin (data)
2328   "Fetch BUIN and return uin number."
2329   (string-to-number (emchat-v8-fetch-string data (emchat-v8-fetch-byte data))))
2330 (defun emchat-v8-pack-buin (uin)
2331   (let ((suin (number-to-string uin)))
2332     (concat (emchat-v8-pack-byte (length suin)) suin)))
2333
2334 (defun emchat-v8-fetch-bstr (data)
2335   (let* ((len (emchat-v8-fetch-word data))
2336          (str (emchat-v8-fetch-string data len)))
2337     (substring str 0 len)))
2338
2339 (defun emchat-v8-pack-bstr (str)
2340   (concat (emchat-v8-pack-word (length str)) str))
2341
2342 ;; Various packers
2343 (defun emchat-v8-pack-uinlist (uin-list)
2344   (apply 'concat (mapcar 'emchat-v8-pack-buin uin-list)))
2345
2346 (defun emchat-v8-pack-nts (string)
2347   (concat string (char-to-string 0)))
2348
2349 (defun emchat-v8-pack-lnts (string)
2350   (let ((nts (emchat-v8-pack-nts string)))
2351     (concat
2352      (emchat-v8-pack-word-le (length nts))
2353      nts)))
2354
2355 (defun emchat-v8-pack-llnts (string)
2356   (let ((nts (emchat-v8-pack-nts string)))
2357     (concat
2358      (emchat-v8-pack-word-le (+ (length nts) 2))
2359      (emchat-v8-pack-word-le (length nts))
2360      nts)))
2361
2362 (defun emchat-v8-fetch-lnts (data)
2363   (let* ((len (emchat-v8-fetch-word-le data))
2364          (str (emchat-v8-fetch-string data len)))
2365     (substring str 0 (1- len))))
2366
2367 ;; FLAP
2368 (defun emchat-v8-fetch-flap (data)
2369   "Get next queued FLAP from emchat context ECTX."
2370   (set-process-filter
2371    (emchat-v8-ctx-proc data) 'emchat-v8-proc-filter-accumulator)
2372
2373   (unwind-protect
2374       (progn
2375         (let ((bb (emchat-v8-fetch-byte data)))
2376           (unless (= bb #x2A)
2377             (error "Unexpected data while fetching FLAP")))
2378
2379         (let* ((cin (emchat-v8-fetch-byte data))
2380                (seq (emchat-v8-fetch-word data))
2381                (flen (emchat-v8-fetch-word data))
2382                (fdata (emchat-v8-fetch-data data flen)))
2383           (list cin seq fdata)))
2384
2385     (set-process-filter
2386      (emchat-v8-ctx-proc data) 'emchat-v8-proc-filter-proccessing)))
2387
2388 (defun emchat-v8-pack-flap (ectx chan-id &rest flap-data)
2389   "Create FLAP packet of channel id CHAN-ID and DATA."
2390   (setq flap-data (apply 'concat flap-data))
2391
2392   (prog1
2393       (concat
2394        (emchat-v8-pack-byte #x2A)
2395        (emchat-v8-pack-byte chan-id)
2396        (emchat-v8-pack-word (emchat-v8-ctx-sequence ectx))
2397        (emchat-v8-pack-word (length flap-data))
2398        flap-data)
2399
2400     ;; Increase sequence number
2401     (incf (emchat-v8-ctx-sequence ectx))
2402     (when (> (emchat-v8-ctx-sequence ectx) 65535)
2403       (setf (emchat-v8-ctx-sequence ectx)
2404             (% (emchat-v8-ctx-sequence ectx) 65536)))))
2405 (put 'emchat-v8-pack-flap 'lisp-indent-function 2)
2406
2407 ;; SNAC
2408 (defun emchat-v8-fetch-snac (data)
2409   "Get next SNAC."
2410   (let ((family (emchat-v8-fetch-word data))
2411         (subtype (emchat-v8-fetch-word data))
2412         (flags (emchat-v8-fetch-word data))
2413         (rid (emchat-v8-fetch-dword data)))
2414
2415     ;; If 15th bit is set in FLAGS then DATA contains some additional
2416     ;; data in format LENGTH [WORD], DATA [LENGTH]
2417     (unless (zerop (logand flags 32768))
2418       (let ((len (emchat-v8-fetch-word data)))
2419         (emchat-v8-fetch-data data len)))
2420
2421     (list family subtype flags rid)))
2422
2423 (defun emchat-v8-pack-snac (ectx family-subtype &rest snac-data)
2424   "Create SNAC packet."
2425   (setq snac-data (apply 'concat snac-data))
2426   (emchat-v8-pack-flap ectx 2
2427     (emchat-v8-pack-word (car family-subtype))
2428     (emchat-v8-pack-word (cdr family-subtype))
2429     (emchat-v8-pack-word 0)               ; XXX flags
2430     (emchat-v8-pack-dword 0)              ; XXX rid
2431     snac-data))
2432 (put 'emchat-v8-pack-snac 'lisp-indent-function 2)
2433
2434 ;; TLVs
2435 (defun emchat-v8-fetch-single-tlv (data)
2436   (let* ((type (emchat-v8-fetch-word data))
2437          (len (emchat-v8-fetch-word data))
2438          (value (emchat-v8-fetch-data data len)))
2439     (list type len value)))
2440
2441 (defun emchat-v8-fetch-tlvs (data)
2442   "From VMSG extract TLV list."
2443   (let ((tlvs nil))
2444     (while (> (length (aref data 0)) 0)
2445       (setq tlvs (cons (emchat-v8-fetch-single-tlv data) tlvs)))
2446     (nreverse tlvs)))
2447
2448 (defun emchat-v8-fetch-n-tlvs (data n)
2449   "Read TLVs of total length N and return a list."
2450   (let ((tlvs nil))
2451     (while (> n 0)
2452       (let* ((tlv (emchat-v8-fetch-single-tlv data)))
2453         (setq n (- n (emchat-v8-tlv-len tlv) 4)
2454               tlvs (cons tlv tlvs))))
2455     (nreverse tlvs)))
2456
2457 (defun emchat-v8-tlv-get (tlv-list type)
2458   "From TLV list TLV-LIST get tlv of TYPE."
2459   (while (and tlv-list (not (= (emchat-v8-tlv-type (car tlv-list)) type)))
2460     (setq tlv-list (cdr tlv-list)))
2461   (car tlv-list))
2462
2463 (defun emchat-v8-pack-tlv (type &rest values)
2464   "Create TLV."
2465   (let ((val (apply 'concat values)))
2466     (concat
2467      (emchat-v8-pack-word type)
2468      (emchat-v8-pack-word (length val))
2469      val)))
2470 (put 'emchat-v8-pack-tlv 'lisp-indent-function 1)
2471
2472 \f
2473 (defun emchat-v8-login (ectx &optional uin password)
2474   "In ECTX context send UIN/PASSWORD to ICQ server."
2475   (emchat-v8-debug "Logging in ..")
2476
2477   (unless uin
2478     (setq uin (plist-get (emchat-v8-ctx-userinfo ectx) 'uin)))
2479   (unless password
2480     (setq password (plist-get (emchat-v8-ctx-userinfo ectx) 'password)))
2481
2482   ;; Remove password (for somekind of security)
2483   (setf (emchat-v8-ctx-userinfo ectx)
2484         (plist-remprop (emchat-v8-ctx-userinfo ectx) 'password))
2485
2486   (emchat-v8-send ectx
2487     (emchat-v8-pack-flap ectx emchat-v8-FLAP-HELLO
2488       (emchat-v8-pack-dword 1)
2489       (emchat-v8-pack-tlv 1
2490         (number-to-string uin))
2491       (emchat-v8-pack-tlv 2 (emchat-v8-util-encrypt password))
2492       (emchat-v8-pack-tlv 3 emchat-v8-client-id-string)
2493       (emchat-v8-pack-tlv #x16
2494         (emchat-v8-pack-word #x010A))
2495       (emchat-v8-pack-tlv #x17
2496         (emchat-v8-pack-word emchat-v8-FLAP-VER-MAJOR))
2497       (emchat-v8-pack-tlv #x18
2498         (emchat-v8-pack-word emchat-v8-FLAP-VER-MINOR))
2499       (emchat-v8-pack-tlv #x19
2500         (emchat-v8-pack-word emchat-v8-FLAP-VER-LESSER))
2501       (emchat-v8-pack-tlv #x1A
2502         (emchat-v8-pack-word emchat-v8-FLAP-VER-BUILD))
2503       (emchat-v8-pack-tlv #x14
2504         (emchat-v8-pack-dword emchat-v8-FLAP-VER-SUBBUILD))
2505       (emchat-v8-pack-tlv #x0F "en")
2506       (emchat-v8-pack-tlv #x0E "us"))))
2507
2508 \f
2509 (provide 'emchat-v8)
2510
2511 ;;; emchat-v8.el ends here