factor/contrib/aim/aim.factor

324 lines
8.1 KiB
Factor

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 ;