From a97c50abd098db4064a45fd38c7701d6d2c92b6f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 19 Sep 2005 00:23:06 +0000 Subject: [PATCH] Initial checkin. bug-demo shows the bug. --- contrib/aim/aim.factor | 323 +++++++++++++++++++++++++++++++++++ contrib/aim/load.factor | 9 + contrib/aim/net-bytes.factor | 124 ++++++++++++++ 3 files changed, 456 insertions(+) create mode 100644 contrib/aim/aim.factor create mode 100644 contrib/aim/load.factor create mode 100644 contrib/aim/net-bytes.factor diff --git a/contrib/aim/aim.factor b/contrib/aim/aim.factor new file mode 100644 index 0000000000..5460d613b5 --- /dev/null +++ b/contrib/aim/aim.factor @@ -0,0 +1,323 @@ +IN: aim +USING: kernel sequences lists stdio prettyprint strings namespaces math unparser threads vectors errors parser interpreter test io crypto ; + +SYMBOL: aim-login-server +SYMBOL: icq-login-server +SYMBOL: login-port + +SYMBOL: client-md5-string +SYMBOL: client-id-string +SYMBOL: client-id-num +SYMBOL: client-major-ver +SYMBOL: client-minor-ver +SYMBOL: client-lesser-ver +SYMBOL: client-build-num +SYMBOL: client-distro-num +SYMBOL: client-language +SYMBOL: client-country +SYMBOL: client-ssi-flag + +SYMBOL: username +SYMBOL: password +SYMBOL: conn +SYMBOL: seq-num + +SYMBOL: stage-num +SYMBOL: login-key +SYMBOL: aim-chat-ip +SYMBOL: aim-chat-port +SYMBOL: auth-code + +: initialize ( username password -- ) + "login.oscar.aol.com" aim-login-server set + "login.icq.com" icq-login-server set + 5190 login-port set + + "AOL Instant Messenger (SM)" client-md5-string set + "AOL Instant Messenger, version 5.5 3595/WIN32" client-id-string set + ! "AOL Instant Messenger, version 5.9 3690/WIN32" client-id-string set + HEX: 109 client-id-num set + 5 client-major-ver set + 5 client-minor-ver set + 0 client-lesser-ver set + 3595 client-build-num set + 260 client-distro-num set + "en" client-language set + "us" client-country set + 1 client-ssi-flag set + + 0 65535 random-int seq-num set + 1 stage-num set + password set + username set + aim-login-server get login-port get conn set ; + +: get-seq-num ( -- int ) + seq-num get seq-num [ 1 + ] change ; + +: (send-aim) ( str -- ) + conn get [ stream-write ] keep stream-flush ; + + +: (prepend-aim-protocol) ( data -- ) + [ + HEX: 2a >byte + stage-num get >byte + get-seq-num >short + ] make-packet + swap dup >r length >short r> append append ; + +: send-aim ( data -- ) + make-packet + (prepend-aim-protocol) + "Sending: " print dup hexdump + (send-aim) ; + +: read-net ( n s -- bc ) + stream-read + "Received: " print dup hexdump ; + +: drop-header ( str -- ) + 6 swap tail ; + +: parse-snac ( str -- ) + "SNAC" print + dup head-short . + dup head-short . + dup head-short . + head-int . ; + +: with-aim ( quot -- ) + conn get swap with-default-stream ; + +: read-aim ( -- bc ) + [ + head-byte . + head-byte . + ] with-aim ; + +: make-snac ( fam subtype flags req-id -- ) + 4 >nvector { >short >short >short >int } papply ; + +: send-first ( -- ) + [ 1 >int ] send-aim ; + +: send-second ( -- ) + [ + HEX: 17 HEX: 6 0 0 make-snac + 1 >short + username get length >short + username get + HEX: 4b >short + HEX: 00 >short + HEX: 5a >short + HEX: 00 >short + ] send-aim ; + + +: respond-second ( -- ) + [ + HEX: 17 HEX: 2 0 0 make-snac + 1 >short + username get length >short + username get + + ! password hash chunk + 25 >short + 10 >short append + login-key get append + password get string>md5 append + client-md5-string get append + string>md5 >string + + HEX: 4c >short + HEX: 00 >short + HEX: 16 >short HEX: 02 >short client-id-num get >short + HEX: 03 >short client-id-string get length >short client-id-string get + HEX: 17 >short HEX: 02 >short client-major-ver get >short + HEX: 18 >short HEX: 02 >short client-minor-ver get >short + HEX: 19 >short HEX: 02 >short client-lesser-ver get >short + HEX: 1a >short HEX: 02 >short client-build-num get >short + HEX: 14 >short HEX: 04 >short client-distro-num get >int + HEX: 0f >short client-language get length >short client-language get + HEX: 0e >short client-country get length >short client-country get + HEX: 4a >short HEX: 01 >short client-ssi-flag get >byte + ] send-aim ; + +: parse-second ( str -- ) + ; + ! drop-header + ! dup parse-snac + ! dup head-short-be swap head-string-nonull login-key set + ! respond-second ; + +: print-op ( op -- ) + "Op: " write . ; + +: parse-server ( ip:port -- ) + ":" split [ first ] keep second string>number aim-chat-port set aim-chat-ip set ; + +! : process-third-chunks ( bc -- ) + ! dup bc-bytes empty? [ + ! drop + ! ] [ + ! dup head-short-be + ! over head-short-be + ! swap + ! { + ! { [ dup 1 = ] [ print-op over head-string-nonull . ] } + ! { [ dup 5 = ] [ print-op over head-string-nonull dup . parse-server ] } + ! { [ dup 6 = ] [ print-op over head-string-nonull dup . auth-code set ] } + ! { [ dup 8 = ] [ print-op over head-string-nonull . ] } + ! { [ t ] [ print-op over head-string-nonull . ] } + ! } cond + ! process-third-chunks + ! ] ifte ; +! +! : parse-third ( bc -- ) + ! dup drop-header + ! dup parse-snac + ! process-third-chunks ; + +: send-third ( -- ) + [ + 1 >int + 6 >short + auth-code get length + auth-code get + ] send-aim ; + +: send-fourth ( -- ) + [ + 1 HEX: 17 0 HEX: 17 make-snac + [ 1 4 HEX: 13 3 2 1 3 1 4 1 6 1 8 1 9 1 HEX: a 1 HEX: b 1 ] + [ >short ] each + ] send-aim ; + +: send-fifth ( -- ) + [ + 1 6 0 6 make-snac + ] send-aim ; + +: send-sixth ( -- ) + [ + 1 8 0 8 make-snac + [ 1 2 3 4 5 ] [ >short ] each + ] send-aim ; + +: send-bunch ( -- ) + [ 1 HEX: e 0 HEX: e make-snac ] send-aim + [ HEX: 13 2 0 2 make-snac ] send-aim + + [ + HEX: 13 5 HEX: 7e6d 5 make-snac + HEX: 41c1 >int + HEX: 3670 >int + HEX: bb >short + ] send-aim + + [ 2 2 0 2 make-snac ] send-aim + [ 2 3 0 2 make-snac ] send-aim + [ 3 2 0 2 make-snac ] send-aim + [ 4 4 0 4 make-snac ] send-aim + [ 9 2 0 2 make-snac ] send-aim ; + +: send-bunch2 + [ + HEX: 13 7 0 7 make-snac + ] send-aim + + [ + 2 4 0 4 make-snac + 5 >short + HEX: d >short + [ + HEX: 094601054c7f11d1 HEX: 8222444553540000 + HEX: 0946134a4c7f11d1 HEX: 8222444553540000 + HEX: 0946134b4c7f11d1 HEX: 8222444553540000 + HEX: 748f2420628711d1 HEX: 8222444553540000 + HEX: 0946134d4c7f11d1 HEX: 8222444553540000 + HEX: 094613414c7f11d1 HEX: 8222444553540000 + HEX: 094600004c7f11d1 HEX: 8222444553540000 + HEX: 094613434c7f11d1 HEX: 8222444553540000 + HEX: 094601ff4c7f11d1 HEX: 8222444553540000 + HEX: 094601014c7f11d1 HEX: 8222444553540000 + HEX: 094613454c7f11d1 HEX: 8222444553540000 + HEX: 094601034c7f11d1 HEX: 8222444553540000 + HEX: 094613474c7f11d1 HEX: 8222444553540000 + ] [ >long ] each + 6 >short + 6 >short + 4 >short + 2 >short + 2 >short + ] send-aim + + [ + 4 2 0 2 make-snac + 0 >int + HEX: b >short + HEX: 1f40 >short + HEX: 03e70 >short + HEX: 03e70 >short + 0 >int + ] send-aim + + [ + 1 2 0 2 make-snac + [ + HEX: 1 HEX: 4 HEX: 110 HEX: 8f1 + HEX: 13 HEX: 3 HEX: 110 HEX: 8f1 + HEX: 2 HEX: 1 HEX: 110 HEX: 8f1 + HEX: 3 HEX: 1 HEX: 110 HEX: 8f1 + HEX: 4 HEX: 4 HEX: 110 HEX: 8f1 + HEX: 6 HEX: 1 HEX: 110 HEX: 8f1 + HEX: 8 HEX: 1 HEX: 104 HEX: 8f1 + HEX: 9 HEX: 1 HEX: 110 HEX: 8f1 + HEX: a HEX: 1 HEX: 110 HEX: 8f1 + HEX: b HEX: 1 HEX: 110 HEX: 8f1 + ] [ >short ] each + ] send-aim ; + +: connect-aim ( -- ) + ! first server + ! new connection stage + ! send-first + ! read-aim drop + ! stage-num [ 1 + ] change + + ! normal transmission stage + ! send-second + ! read-aim parse-second + ! read-aim parse-third + ! read-aim drop + ! conn get stream-close + + ! second server + ! 1 stage-num set + ! aim-chat-ip get aim-chat-port get conn set + ! send-third + ! read-aim drop + ! stage-num [ 1 + ] change + ! ! read-aim + ! send-fourth + ! send-fifth + ! ! read-aim + ! ! read-aim + ! ! read-aim + ! send-sixth + ! send-bunch + ! ! 9 [ drop read-aim drop ] each + ! send-bunch2 + ; + +: bug-demo ( -- ) + "username" "password" initialize + send-first + [ head-byte . ] with-aim + [ head-byte . ] with-aim + ; + +: test-login ( -- ) + "username" "password" initialize connect-aim ; + diff --git a/contrib/aim/load.factor b/contrib/aim/load.factor new file mode 100644 index 0000000000..ea86866df9 --- /dev/null +++ b/contrib/aim/load.factor @@ -0,0 +1,9 @@ +IN: network-util +USING: parser sequences ; + +[ + "contrib/crypto/load.factor" + "contrib/aim/net-bytes.factor" + "contrib/aim/aim.factor" +] [ run-file ] each + diff --git a/contrib/aim/net-bytes.factor b/contrib/aim/net-bytes.factor new file mode 100644 index 0000000000..eb3b5784a1 --- /dev/null +++ b/contrib/aim/net-bytes.factor @@ -0,0 +1,124 @@ +IN: aim +USING: kernel sequences lists stdio prettyprint strings namespaces math unparser threads vectors errors parser interpreter test io crypto ; + +SYMBOL: big-endian t big-endian set +SYMBOL: default-stream + + +: >nvector ( elems n -- ) + { } clone swap [ drop swap add ] each reverse ; + +! TODO: make this work for types other than "" +: papply ( seq seq -- seq ) + [ [ 2list call % ] 2each ] "" make ; + +! Examples: +! 1 2 3 4 4 >nvector . +! { 1 2 3 4 } + +! { 1 2 3 4 } { >byte >short >int >long } papply . +! "\u0001\0\u0002\0\0\0\u0003\0\0\0\0\0\0\0\u0004" + +! [ 1 >short 6 >long ] make-packet . +! "\0\u0001\0\0\0\0\0\0\0\u0006" + +: with-default-stream ( stream quot -- ) + [ + swap default-stream set + [ default-stream get stream-close rethrow ] + catch + ] with-scope ; + +: >endian ( obj n -- str ) + big-endian get [ >be ] [ >le ] ifte ; + +: endian> ( obj n -- str ) + big-endian get [ be> ] [ le> ] ifte ; + +: >byte ( byte -- str ) + 1 >le ; + +: >short ( short -- str ) + 2 >endian ; + +: >int ( int -- str ) + 4 >endian ; + +: >long ( long -- str ) + 8 >endian ; + +: >cstring ( str -- str ) + "\0" append ; + +: make-packet ( quot -- ) + depth >r call depth r> - [ drop append ] each ; + +: (head-byte) ( str -- byte ) + 1 swap head endian> ; +: (head-short) ( str -- short ) + 2 swap head endian> ; +: (head-int) ( str -- int ) + 4 swap head endian> ; +: (head-long) ( str -- long ) + 8 swap head endian> ; + + +: head-byte ( -- byte ) + 1 default-stream get stream-read (head-byte) ; + +: head-short ( -- short ) + 2 default-stream get stream-read (head-short) ; + +: head-int ( -- int ) + 4 default-stream get stream-read (head-int) ; + +: head-long ( -- long ) + 8 default-stream get stream-read (head-long) ; + + +! wrote this months and months ago.. +! NEEDS REFACTORING, GOSH! +! Hexdump +: (print-offset) ( lineno -- ) + 16 * >hex 8 CHAR: 0 pad-left write "h: " write ; + +: (print-hex-digit) ( digit -- ) + >hex 2 CHAR: 0 pad-left write ; + +: (print-hex-line) ( lineno string -- ) + over (print-offset) + dup length dup 16 = + [ [ 2dup swap nth (print-hex-digit) " " write ] repeat ] ! full line + [ ! partial line + [ 2dup swap nth (print-hex-digit) " " write ] repeat + dup length 16 swap - [ " " write ] repeat + ] ifte + dup length + [ 2dup swap nth dup printable? [ write1 ] [ "." write drop ] ifte ] repeat + terpri drop ; + +: (num-full-lines) ( bytes -- ) + length 16 / floor ; + +: (get-slice) ( lineno bytes -- ) + >r dup 16 * dup 16 + r> ; + +: (get-last-slice) ( bytes -- ) + dup length dup 16 mod - over length rot ; + +: (print-bytes) ( bytes -- ) + dup (num-full-lines) [ over (get-slice) (print-hex-line) ] repeat + dup (num-full-lines) over (get-last-slice) dup empty? [ 3drop ] [ (print-hex-line) 2drop ] ifte ; + +: (print-length) ( len -- ) + [ + "Length: " % + dup unparse % + ", " % + >hex % + "h\n" % + ] "" make write ; + +: hexdump ( str -- ) + dup length (print-length) (print-bytes) ; +