#!/data/languages/clisp/bin/clisp -ansi -q -Kfull
;;;; -*- mode:lisp; coding:iso-8859-1 -*-
;;;;*****************************************************************************
;;;;FILE:              dump-multiplayer
;;;;LANGUAGE:          common lisp (clisp)
;;;;SYSTEM:            UNIX
;;;;USER-INTERFACE:    UNIX
;;;;DESCRIPTION
;;;;
;;;;    This script dumps connects to a multiplayer server, and dumps
;;;;    the multiplayer UDP traffic
;;;;
;;;;USAGE
;;;;
;;;;AUTHORS
;;;;    <PJB> Pascal J. Bourguignon
;;;;MODIFICATIONS
;;;;    2011-04-08 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;;    Copyright Pascal J. Bourguignon 2011 - 2011
;;;;
;;;;    This script is free software; you can redistribute it and/or
;;;;    modify it under the terms of the GNU  General Public
;;;;    License as published by the Free Software Foundation; either
;;;;    version 2 of the License, or (at your option) any later version.
;;;;
;;;;    This script is distributed in the hope that it will be useful,
;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;;    General Public License for more details.
;;;;
;;;;    You should have received a copy of the GNU General Public
;;;;    License along with this library; see the file COPYING.LIB.
;;;;    If not, write to the Free Software Foundation,
;;;;    59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;;;*****************************************************************************


(load "~/.clisprc.lisp")
(require "rawsock")
(push #P"~/src/lisp/fgfs/" asdf:*central-registry*)
(asdf-load :com.ogamita.fgfs.dump-net-fdm)

(defpackage "COM.OGAMITA.FGFS.MULTIPLAYER.DUMP"
  (:use "COMMON-LISP"
        "COM.OGAMITA.FGFS.UDP"
        "COM.OGAMITA.FGFS.MULTIPLAYER"))
(in-package "COM.OGAMITA.FGFS.MULTIPLAYER.DUMP")

(use-package :com.ogamita.fgfs.net-fdm-24)


#||

(with-open-file (stream "test.udp"
                        :element-type '(unsigned-byte 8)
                        :direction :output
                        :if-does-not-exist :create
                        :if-exists :supersede)
  (xwrite-header
   (make-header :magic +header-magic+
                :version #x00010001
                :msg-id 6
                :msg-len 24
                :reply-address 0
                :reply-port 0
                :call-sign "AC112U")
   stream))

||#






(defparameter *remote-address*
  (make-address :host "mpserver10.flightgear.org" :port 5000))

(defparameter *local-address*
  (make-address :host "0.0.0.0"                   :port 5503))


(defmacro check-errors (message &body body)
  (let ((verr (gensym))
        (vmsg (gensym)))
    `(let ((,vmsg ,message))
       (handler-case
           (multiple-value-prog1 (progn ,@body)
             (format t "~&~A succeeded.~%" ,vmsg)
             (finish-output))
         (error (,verr)
           (format t "~%~A: ~A~%" ,vmsg ,verr)
           (throw 'errors ,verr))))))




;; (check-errors "(setf rawsock:socket-option)"
;;               (setf (rawsock:socket-option socket LINUX:O_NONBLOCK) t))
;; (check-errors "posix:stream-options" (posix:stream-options socket :fd :nonblock))
;; (setf (rawsock:socket-option socket LINUX:O_NONBLOCK) t)
;; (let ((name (rawsock:make-sockaddr :inet (+ 6 8))))
;;   (rawsock:getsockname socket name)
;;   (print name))




(defun send-message (callsign message)
  (catch 'errors
    (let ((remote (make-sockaddr :inet *remote-address*))
          (local  (make-sockaddr :inet *local-address*))
          (buffer (make-array 65536 :element-type '(unsigned-byte 8) :initial-element 0))
          (socket (rawsock:socket :inet :dgram 0)))
      (unwind-protect
           (progn
             (check-errors "(set-blocking)" (set-blocking socket nil))
             (check-errors "bind"           (rawsock:bind socket local))
             (check-errors (format nil "(bind ~A ~A)" socket local)
                           (rawsock:connect socket remote))

             (let ((buffer (make-byte-buffer)))
               (xwrite-chat-message (make-message callsign message) buffer)
               (check-errors (format nil "(sendto socket=~A (~D bytes) remote=~A)"
                                     socket
                                     (length  (byte-buffer-bytes buffer))
                                     remote)
                             (rawsock:sendto socket (byte-buffer-bytes buffer) remote)))
             (loop :repeat 100 :do
                (catch 'errors
                  (check-errors (format nil "(recvfrom ~A ~A)" socket remote)
                                (rawsock:recvfrom socket buffer remote))
                  (let ((byte-buffer (make-byte-buffer :bytes buffer)))
                    (print (decode-message byte-buffer))))))
        (rawsock:sock-close socket)))))






(defun real-time ()
  (/ (GET-INTERNAL-REAL-TIME)
     (load-time-value (float INTERNAL-TIME-UNITS-PER-SECOND 0.0d0))))

(defmacro heart-beat ((next-time &key frequency period) &body body)
  (when (and frequency period)
    (error ":frequency and :period are mutually exclusive."))
  (unless (or frequency period)
    (error ":frequency or :period are mandatory."))
  (let ((vperiod (gensym "period"))
        (vnext   (gensym "next")))
    `(let* ((,vperiod ,(if frequency
                           `(/ ,frequency)
                           period))
            (,vnext   (+ ,vperiod (real-time))))
       (loop
          (let ((delay  (- ,vnext (real-time))))
            (when (plusp delay)
              ;; (print `(sleep ,delay))
              (sleep delay)))
          (incf ,vnext ,vperiod)
          (let ((,next-time ,vnext))
            ,@body)))))


(defparameter *current-position*
  (coerce
   #(#x46 #x47 #x46 #x53 #x00 #x01 #x00 #x01 #x00 #x00 #x00 #x07 #x00
     #x00 #x03 #xe0 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x41 #x43
     #x31 #x31 #x32 #x52 #x00 #x00 #x41 #x69 #x72 #x63 #x72 #x61 #x66
     #x74 #x2f #x66 #x2d #x31 #x34 #x62 #x2f #x4d #x6f #x64 #x65 #x6c
     #x73 #x2f #x66 #x2d #x31 #x34 #x62 #x2e #x78 #x6d #x6c #x00 #x00
     #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
     #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
     #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
     #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
     #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x40 #xa0
     #x6f #x48 #x88 #x88 #x98 #x63 #x3f #xa9 #x99 #x99 #x99 #x99 #x99
     #x9a #xc1 #x44 #xac #x16 #xb2 #x16 #x03 #x52 #xc1 #x50 #x4a #x94
     #x3a #xdd #x63 #x14 #x41 #x4d #x8c #x3d #x85 #x4d #x86 #xaa #xbf
     #xf6 #x72 #xdf #x3f #x8e #xc5 #x57 #xbd #x1a #x81 #x2a #xbf #xb2
     #x82 #xd2 #x3f #x3b #x6f #xd1 #x3b #xf3 #xd3 #xe9 #x36 #x11 #x0d
     #x00 #x38 #xd5 #x1d #xf6 #x37 #xd5 #x9d #x98 #x00 #x00 #x00 #x00
     #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
     #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
     #x00 #x67 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x68 #x00 #x00 #x00
     #x00 #x00 #x00 #x00 #x69 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x6a
     #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x6b #x00 #x00 #x00 #x00 #x00
     #x00 #x00 #x6e #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x6f #x00 #x00
     #x00 #x00 #x00 #x00 #x00 #x70 #x3d #xb4 #x38 #xaf #x00 #x00 #x00
     #xc8 #x3e #x17 #xe0 #xe0 #x00 #x00 #x00 #xc9 #x3f #x80 #x00 #x00
     #x00 #x00 #x00 #xd2 #x3e #xd1 #x7a #x3f #x00 #x00 #x00 #xd3 #x3f
     #x80 #x00 #x00 #x00 #x00 #x00 #xdc #x3e #xd1 #x6d #x65 #x00 #x00
     #x00 #xdd #x3f #x80 #x00 #x00 #x00 #x00 #x01 #x2c #x42 #x5c #x03
     #x4a #x00 #x00 #x01 #x2d #x42 #x92 #x01 #x92 #x00 #x00 #x01 #x2e
     #x00 #x00 #x00 #x00 #x00 #x00 #x01 #x36 #x42 #x5c #x03 #x4a #x00
     #x00 #x01 #x37 #x42 #x92 #x01 #x92 #x00 #x00 #x01 #x38 #x00 #x00
     #x00 #x00 #x00 #x00 #x03 #xe9 #x00 #x00 #x00 #x00 #x00 #x00 #x03
     #xea #x00 #x00 #x00 #x00 #x00 #x00 #x03 #xeb #x00 #x00 #x00 #x00
     #x00 #x00 #x03 #xec #x00 #x00 #x00 #x01 #x00 #x00 #x03 #xed #x00
     #x00 #x00 #x01 #x00 #x00 #x03 #xee #x00 #x00 #x00 #x00 #x00 #x00
     #x04 #x4d #x00 #x00 #x00 #x08 #x00 #x00 #x00 #x73 #x00 #x00 #x00
     #x77 #x00 #x00 #x00 #x6f #x00 #x00 #x00 #x72 #x00 #x00 #x00 #x64
     #x00 #x00 #x00 #x6d #x00 #x00 #x00 #x65 #x00 #x00 #x00 #x6e #x00
     #x00 #x27 #x11 #x00 #x00 #x00 #x09 #x00 #x00 #x00 #x31 #x00 #x00
     #x00 #x31 #x00 #x00 #x00 #x38 #x00 #x00 #x00 #x35 #x00 #x00 #x00
     #x30 #x00 #x00 #x00 #x30 #x00 #x00 #x00 #x30 #x00 #x00 #x00 #x30
     #x00 #x00 #x00 #x30 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
     #x00 #x00 #x00 #x00 #x00 #x27 #x12 #x00 #x00 #x00 #x05 #x00 #x00
     #x00 #x48 #x00 #x00 #x00 #x65 #x00 #x00 #x00 #x6c #x00 #x00 #x00
     #x6c #x00 #x00 #x00 #x6f #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
     #x00 #x00 #x00 #x00 #x00 #x00 #x27 #x74 #x00 #x00 #x00 #x16 #x00
     #x00 #x00 #x65 #x00 #x00 #x00 #x70 #x00 #x00 #x00 #x65 #x00 #x00
     #x00 #x70 #x00 #x00 #x00 #x54 #x00 #x00 #x00 #x4b #x00 #x00 #x00
     #x65 #x00 #x00 #x00 #x70 #x00 #x00 #x00 #x65 #x00 #x00 #x00 #x70
     #x00 #x00 #x00 #x65 #x00 #x00 #x00 #x70 #x00 #x00 #x00 #x65 #x00
     #x00 #x00 #x70 #x00 #x00 #x00 #x54 #x00 #x00 #x00 #x4b #x00 #x00
     #x00 #x65 #x00 #x00 #x00 #x70 #x00 #x00 #x00 #x65 #x00 #x00 #x00
     #x70 #x00 #x00 #x00 #x63 #x00 #x00 #x00 #x6c #x00 #x00 #x00 #x00
     #x00 #x00 #x00 #x00 #x00 #x00 #x27 #x75 #x00 #x00 #x00 #x27 #x00
     #x00 #x00 #x30 #x00 #x00 #x00 #x2e #x00 #x00 #x00 #x30 #x00 #x00
     #x00 #x3b #x00 #x00 #x00 #x2d #x00 #x00 #x00 #x30 #x00 #x00 #x00
     #x2e #x00 #x00 #x00 #x30 #x00 #x00 #x00 #x3b #x00 #x00 #x00 #x31
     #x00 #x00 #x00 #x34 #x00 #x00 #x00 #x34 #x00 #x00 #x00 #x31 #x00
     #x00 #x00 #x34 #x00 #x00 #x00 #x3b #x00 #x00 #x00 #x30 #x00 #x00
     #x00 #x3b #x00 #x00 #x00 #x30 #x00 #x00 #x00 #x2e #x00 #x00 #x00
     #x30 #x00 #x00 #x00 #x3b #x00 #x00 #x00 #x31 #x00 #x00 #x00 #x3b
     #x00 #x00 #x00 #x31 #x00 #x00 #x00 #x34 #x00 #x00 #x00 #x2e #x00
     #x00 #x00 #x38 #x00 #x00 #x00 #x3b #x00 #x00 #x00 #x33 #x00 #x00
     #x00 #x3b #x00 #x00 #x00 #x30 #x00 #x00 #x00 #x2e #x00 #x00 #x00
     #x30 #x00 #x00 #x00 #x30 #x00 #x00 #x00 #x3b #x00 #x00 #x00 #x32
     #x00 #x00 #x00 #x35 #x00 #x00 #x00 #x39 #x00 #x00 #x00 #x3b #x00
     #x00 #x00 #x00 #x00 #x00 #x27 #x76 #x00 #x00 #x00 #x02 #x00 #x00
     #x00 #x35 #x00 #x00 #x00 #x30 #x00 #x00 #x00 #x00 #x00 #x00 #x00
     #x00 #x00 #x00 #x27 #xd8 #x00 #x00 #x00 #x01 #x00 #x00 #x00 #x30
     #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
     #x00 #x27 #xda #x00 #x00 #x00 #x00 #x00 #x00 #x27 #xdb #x00 #x00
     #x00 #x00 #x00 #x00 #x27 #xdc #x39 #x18 #xa0 #x00 #x00 #x00 #x27
     #xdd #x39 #x18 #xa0 #x00 #x00 #x00 #x27 #xde #x00 #x00 #x00 #x00
     #x00 #x00 #x28 #x3c #x00 #x00 #x00 #x00 #x00 #x00 #x28 #x3d #x00
     #x00 #x00 #x00 #x00 #x00 #x28 #x3e #x00 #x00 #x00 #x00 #x00 #x00
     #x28 #x3f #x00 #x00 #x00 #x00 #x00 #x00 #x28 #x40 #x00 #x00 #x00
     #x00 #x00 #x00 #x28 #x41 #x00 #x00 #x00 #x00 #x00 #x00 #x28 #x42
     #x00 #x00 #x00 #x00 )
   '(vector (unsigned-byte 8))))


(defun dump-mp-traffic ()
 (let ((mp (udp-connect *remote-address* *local-address*))
       (buffer (make-array 65536 :element-type '(unsigned-byte 8)
                           :initial-element 0
                           :fill-pointer 65536))
       (*print-right-margin* nil)
       (*print-circle* nil)
       (*print-pretty* nil))
   (with-open-file (out "mptraffic.dump"
                        :direction :output
                        :if-does-not-exist :create
                        :if-exists :append)
     (unwind-protect
          (heart-beat (next-time :frequency 10.0f0)
            (udp-send-packet mp *current-position*)
            (loop
               :while (and (< (real-time) next-time)
                           (ignore-errors
                             (setf (fill-pointer buffer) (array-dimension buffer 0))
                             (setf (fill-pointer buffer) (udp-receive-packet mp buffer))))
               :count 1 :into messages
               :do (print buffer out)
               :do (let ((byte-buffer (make-byte-buffer :bytes buffer)))
                     (print (decode-message byte-buffer)))
               ;; :finally (print `(messages ,messages))
               ))
       (udp-close mp)))))






;; (with-open-file (inp "header.xdr" :element-type '(unsigned-byte 8))
;;   (print (decode-message inp)))


#||

15:55:40.914591 IP kuiper.lan.ogamita.com.5001 > h1774676.stratoserver.net.5000: UDP, length 992
	0x0000:  4500 03fc 0000 4000 4011 f462 c0a8 0702  E.....@.@..b....
	0x0010:  55d6 250e 1389 1388 03e8 ebf2 4647 4653  U.%.........FGFS
	0x0020:  0001 0001 0000 0007 0000 03e0 0000 0000  ................
	0x0030:  0000 0000 4143 3131 3250 0000 4169 7263  ....AC112P..Airc
	0x0040:  7261 6674 2f66 2d31 3462 2f4d 6f64 656c  raft/f-14b/Model
	0x0050:  732f 662d 3134 622e 786d 6c00 0000 0000  s/f-14b.xml.....
	0x0060:  0000 0000 0000 0000 0000 0000 0000 0000  ................
	0x0070:  0000 0000 0000 0000 0000 0000 0000 0000  ................
	0x0080:  0000 0000 0000 0000 0000 0000 0000 0000  ................
	0x0090:  0000 0000 0000 0000 0000 0000 40a0 6f48  ............@.oH
	0x00a0:  8888 9863 3fa9 9999 9999 999a c144 ac16  ...c?........D..
	0x00b0:  b216 0352 c150 4a94 3add 6314 414d 8c3d  ...R.PJ.:.c.AM.=
	0x00c0:  854d 86aa bff6 72df 3f8e c557 bd1a 812a  .M....r.?..W...*
	0x00d0:  bfb2 82d2 3f3b 6fd1 3bf3 d3e9 3611 0d00  ....?;o.;...6...
	0x00e0:  38d5 1df6 37d5 9d98 0000 0000 0000 0000  8...7...........
	0x00f0:  0000 0000 0000 0000 0000 0000 0000 0000  ................
	0x0100:  0000 0000 0000 0067 0000 0000 0000 0068  .......g.......h
	0x0110:  0000 0000 0000 0069 0000 0000 0000 006a  .......i.......j
	0x0120:  0000 0000 0000 006b 0000 0000 0000 006e  .......k.......n
	0x0130:  0000 0000 0000 006f 0000 0000 0000 0070  .......o.......p
	0x0140:  3db4 38af 0000 00c8 3e17 e0e0 0000 00c9  =.8.....>.......
	0x0150:  3f80 0000 0000 00d2 3ed1 7a3f 0000 00d3  ?.......>.z?....
	0x0160:  3f80 0000 0000 00dc 3ed1 6d65 0000 00dd  ?.......>.me....
	0x0170:  3f80 0000 0000 012c 425c 034a 0000 012d  ?......,B\.J...-
	0x0180:  4292 0192 0000 012e 0000 0000 0000 0136  B..............6
	0x0190:  425c 034a 0000 0137 4292 0192 0000 0138  B\.J...7B......8
	0x01a0:  0000 0000 0000 03e9 0000 0000 0000 03ea  ................
	0x01b0:  0000 0000 0000 03eb 0000 0000 0000 03ec  ................
	0x01c0:  0000 0001 0000 03ed 0000 0001 0000 03ee  ................
	0x01d0:  0000 0000 0000 044d 0000 0008 0000 0073  .......M.......s
	0x01e0:  0000 0077 0000 006f 0000 0072 0000 0064  ...w...o...r...d
	0x01f0:  0000 006d 0000 0065 0000 006e 0000 2711  ...m...e...n..'.
	0x0200:  0000 0009 0000 0031 0000 0031 0000 0038  .......1...1...8
	0x0210:  0000 0035 0000 0030 0000 0030 0000 0030  ...5...0...0...0
	0x0220:  0000 0030 0000 0030 0000 0000 0000 0000  ...0...0........
	0x0230:  0000 0000 0000 2712 0000 0005 0000 0048  ......'........H
	0x0240:  0000 0065 0000 006c 0000 006c 0000 006f  ...e...l...l...o
	0x0250:  0000 0000 0000 0000 0000 0000 0000 2774  ..............'t
	0x0260:  0000 0016 0000 0065 0000 0070 0000 0065  .......e...p...e
	0x0270:  0000 0070 0000 0054 0000 004b 0000 0065  ...p...T...K...e
	0x0280:  0000 0070 0000 0065 0000 0070 0000 0065  ...p...e...p...e
	0x0290:  0000 0070 0000 0065 0000 0070 0000 0054  ...p...e...p...T
	0x02a0:  0000 004b 0000 0065 0000 0070 0000 0065  ...K...e...p...e
	0x02b0:  0000 0070 0000 0063 0000 006c 0000 0000  ...p...c...l....
	0x02c0:  0000 0000 0000 2775 0000 0027 0000 0030  ......'u...'...0
	0x02d0:  0000 002e 0000 0030 0000 003b 0000 002d  .......0...;...-
	0x02e0:  0000 0030 0000 002e 0000 0030 0000 003b  ...0.......0...;
	0x02f0:  0000 0031 0000 0034 0000 0034 0000 0031  ...1...4...4...1
	0x0300:  0000 0034 0000 003b 0000 0030 0000 003b  ...4...;...0...;
	0x0310:  0000 0030 0000 002e 0000 0030 0000 003b  ...0.......0...;
	0x0320:  0000 0031 0000 003b 0000 0031 0000 0034  ...1...;...1...4
	0x0330:  0000 002e 0000 0038 0000 003b 0000 0033  .......8...;...3
	0x0340:  0000 003b 0000 0030 0000 002e 0000 0030  ...;...0.......0
	0x0350:  0000 0030 0000 003b 0000 0032 0000 0035  ...0...;...2...5
	0x0360:  0000 0039 0000 003b 0000 0000 0000 2776  ...9...;......'v
	0x0370:  0000 0002 0000 0035 0000 0030 0000 0000  .......5...0....
	0x0380:  0000 0000 0000 27d8 0000 0001 0000 0030  ......'........0
	0x0390:  0000 0000 0000 0000 0000 0000 0000 27da  ..............'.
	0x03a0:  0000 0000 0000 27db 0000 0000 0000 27dc  ......'.......'.
	0x03b0:  3918 a000 0000 27dd 3918 a000 0000 27de  9.....'.9.....'.
	0x03c0:  0000 0000 0000 283c 0000 0000 0000 283d  ......(<......(=
	0x03d0:  0000 0000 0000 283e 0000 0000 0000 283f  ......(>......(?
	0x03e0:  0000 0000 0000 2840 0000 0000 0000 2841  ......(@......(A
	0x03f0:  0000 0000 0000 2842 0000 0000            ......(B....

||#














#||
(with-open-file (out "header.xdr" :direction :output
                     :if-does-not-exist :create
                     :if-exists :supersede
                     :element-type '(unsigned-byte 8))
  (write-sequence *buffer* out))

||#

;; Local Variables:
;; eval: (cl-indent 'heart-beat 1)
;; End:
ViewGit