Doug Coleman
parent
db8fd1cc50
commit
a97c50abd0
|
|
@ -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 <client> 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 <client> 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 ( <net> -- )
|
||||
"username" "password" initialize connect-aim ;
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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 -- <slice> )
|
||||
>r dup 16 * dup 16 + r> <slice> ;
|
||||
|
||||
: (get-last-slice) ( bytes -- <slice> )
|
||||
dup length dup 16 mod - over length rot <slice> ;
|
||||
|
||||
: (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) ;
|
||||
|
||||
Loading…
Reference in New Issue