steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

FAMILY: and OPCODE: take decimal now (not hex) 

General cleanups, handling of some more packet data
cvs
Doug Coleman 2005-10-10 19:34:07 +00:00
parent 01740ac7fb
commit fdb2c33161
2 changed files with 81 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
contrib/aim/aim.factor
View File

@ -75,8 +75,8 @@ SYMBOL: buddy-list
head-int drop ; head-int drop ;
: (unhandled-opcode) ( str -- ) : (unhandled-opcode) ( str -- )
"Family: " write family get >hex "h" append write "Family: " write family get unparse write
", opcode: " write opcode get >hex "h" append writeln ", opcode: " write opcode get unparse writeln
unscoped-stream get contents hexdump ; unscoped-stream get contents hexdump ;
: unhandled-opcode ( -- ) : unhandled-opcode ( -- )
@ -86,7 +86,7 @@ SYMBOL: buddy-list
"Incomplete handling: " write (unhandled-opcode) ; "Incomplete handling: " write (unhandled-opcode) ;
: unhandled-family-opcode ( -- ) : unhandled-family-opcode ( -- )
"Unhandled family: " write family get >hex "h" append writeln "Unhandled family: " write family get unparse writeln
unhandled-opcode ; unhandled-opcode ;
@ -107,21 +107,69 @@ SYMBOL: buddy-list
{{ }} ; {{ }} ;
: FAMILY: ( -- fam# ) : FAMILY: ( -- fam# )
! "FAMILY:" scan 10 base> swons dup car family-table hash dup [
scan hex> swons dup car family-table hash dup [
drop drop
] [ ] [
! "NEW FAMILY, creating table" print
drop {{ }} clone over car family-table set-hash drop {{ }} clone over car family-table set-hash
] if ; parsing ] if ; parsing
: OPCODE: ( fam# -- ) : OPCODE: ( fam# -- )
! "OPCODE:" car family-table hash word scan 10 base> rot set-hash f ; parsing
car family-table hash word scan hex> rot set-hash f ; parsing
: (handle-reply-info)
head-byte head-string name set
"Warning: " write head-short unparse writeln
head-short dup unparse print
[
head-short
head-short head-string <string-reader> [
{
! { [ 1 = ] [ drop head-short drop ] }
! { [ 3 = ] [ drop ] }
! { [ 5 = ] [ drop ] }
! { [ 10 = ] [ drop ] }
! { [ 13 = ] [ drop ] }
! { [ 15 = ] [ drop ] }
! { [ 29 = ] [ drop ] }
! { [ 30 = ] [ drop ] }
! { [ 34 = ] [ drop ] }
{ [ t ] [ " Unhandled tlv 1-15: " write unparse writeln unscoped-stream get contents hexdump ] }
} cond
] with-unscoped-stream
] repeat ;
! : handle-reply-info
! "HANDLE REPLY INFO" print
! 4 [ head-short drop ] repeat
! (handle-reply-info)
! ; FAMILY: 1 OPCODE: 15
! unscoped-stream get empty? [
! ] unless ; FAMILY: 1 OPCODE: 15
! : handle-away-message ! : handle-away-message
! head-byte head-string name set ! head-byte head-string name set
! name get write "'s away message" writeln ; ! name get write "'s away message: " write
! ; FAMILY: 2 OPCODE: 6
: handle-capabilities
unscoped-stream get empty? [
head-long unparse write " " write head-long unparse writeln
handle-capabilities
] unless ;
: handle-29
"(29)" print
head-short drop
head-byte drop
head-byte head-string drop
unscoped-stream get empty? [ handle-29 ] unless ;
: handle-buddy-status : handle-buddy-status
head-byte head-string name set head-byte head-string name set
@ -132,23 +180,20 @@ SYMBOL: buddy-list
head-short head-string <string-reader> [ head-short head-string <string-reader> [
{ {
{ [ dup 1 = ] [ drop name get write head-short HEX: 20 bitand 1 > [ " is away." ] [ " is online." ] if writeln ] } { [ dup 1 = ] [ drop name get write head-short HEX: 20 bitand 1 > [ " is away." ] [ " is online." ] if writeln ] }
{ [ dup 2 = ] [ drop "2: " write head-short unparse writeln ] } { [ dup 2 = ] [ drop "Member since: " write head-short unparse writeln ] }
{ [ dup 3 = ] [ drop name get write " went online at " write head-int unparse writeln name get buddy-signon ] } { [ dup 3 = ] [ drop name get write " went online at " write head-int unparse writeln name get buddy-signon ] }
{ [ dup 4 = ] [ drop name get write " has been idle for " write head-short unparse write " minutes." writeln ] } { [ dup 4 = ] [ drop name get write " has been idle for " write head-short unparse write " minutes." writeln ] }
! { [ dup 5 = ] [ drop ] } { [ dup 6 = ] [ drop name get write ": (6): " write head-short unparse write " " write head-short unparse writeln ] }
! { [ dup 6 = ] [ drop name get write ": (6): " write head-short head-short unparse writeln ] } ! { [ dup 10 = ] [ drop ] } ! external ip
! { [ dup HEX: a = ] [ drop ] } ! { [ dup 12 = ] [ drop ] } ! same as CLI_SETSTATUS
! { [ dup HEX: c = ] [ drop ] } { [ dup 13 = ] [ drop "Capabilities:" print handle-capabilities ] }
! { [ dup HEX: d = ] [ drop ] } { [ dup 15 = ] [ drop name get write " has been online for " write head-int unparse write " seconds." writeln ] }
! { [ dup HEX: e = ] [ drop ] } { [ dup 27 = ] [ drop "(27): " write 4 [ head-int unparse write " " write ] repeat terpri ] }
{ [ dup HEX: f = ] [ drop name get write " has been online for " write head-int unparse write " seconds." writeln ] } { [ dup 29 = ] [ drop handle-29 ] }
! { [ dup HEX: 19 = ] [ drop ] }
! { [ dup HEX: 1b = ] [ drop ] }
! { [ dup HEX: 1d = ] [ drop ] }
{ [ t ] [ " Unhandled tlv 3h-bh: " write unparse writeln unscoped-stream get contents hexdump ] } { [ t ] [ " Unhandled tlv 3h-bh: " write unparse writeln unscoped-stream get contents hexdump ] }
} cond } cond
] with-unscoped-stream ] with-unscoped-stream
] repeat ; FAMILY: 03 OPCODE: 0b ] repeat ; FAMILY: 3 OPCODE: 11
: handle-buddy-signoff ( -- ) : handle-buddy-signoff ( -- )
head-byte head-string name set head-byte head-string name set
@ -160,10 +205,10 @@ SYMBOL: buddy-list
{ {
{ [ dup 1 = ] [ drop name get write " signed off." writeln name get buddy-signoff ] } { [ dup 1 = ] [ drop name get write " signed off." writeln name get buddy-signoff ] }
{ [ dup HEX: 1d = ] [ drop ] } { [ dup HEX: 1d = ] [ drop ] }
{ [ t ] [ "Unhandled tlv 3h-ch: " write unparse writeln ] } { [ t ] [ "Unhandled tlv 3h-ch: " write unparse writeln unscoped-stream get contents hexdump ] }
} cond } cond
] with-unscoped-stream ] with-unscoped-stream
] repeat ; FAMILY: 03 OPCODE: 0C ] repeat ; FAMILY: 3 OPCODE: 12
: (drop-family-4h-header) : (drop-family-4h-header)
head-short drop head-short drop
@ -184,7 +229,7 @@ SYMBOL: buddy-list
{ {
{ [ dup 1 = ] [ drop (parse-incoming-message-text) writeln ] } { [ dup 1 = ] [ drop (parse-incoming-message-text) writeln ] }
{ [ dup 5 = ] [ drop ] } { [ dup 5 = ] [ drop ] }
{ [ t ] [ "Unknown frag: " write unparse writeln ] } { [ t ] [ "Unknown frag: " write unparse writeln unscoped-stream get contents hexdump ] }
} cond } cond
] with-unscoped-stream ] with-unscoped-stream
(parse-incoming-message-tlv2) (parse-incoming-message-tlv2)
@ -199,7 +244,7 @@ SYMBOL: buddy-list
{ [ dup 2 = ] [ drop (parse-incoming-message-tlv2) ] } { [ dup 2 = ] [ drop (parse-incoming-message-tlv2) ] }
{ [ dup 11 = ] [ 2drop ] } { [ dup 11 = ] [ 2drop ] }
{ [ dup 13 = ] [ drop ] } { [ dup 13 = ] [ drop ] }
{ [ t ] [ "Unhandled chunk: " write unparse writeln ] } { [ t ] [ "Unhandled chunk: " write unparse writeln unscoped-stream get contents hexdump ] }
} cond } cond
] with-unscoped-stream ] with-unscoped-stream
(parse-incoming-message-chunks) (parse-incoming-message-chunks)
@ -216,7 +261,7 @@ SYMBOL: buddy-list
{ [ dup 3 = ] [ drop ] } { [ dup 3 = ] [ drop ] }
{ [ dup 15 = ] [ drop ] } { [ dup 15 = ] [ drop ] }
{ [ dup 29 = ] [ drop ] } { [ dup 29 = ] [ drop ] }
{ [ t ] [ "Unknown tlv: " write unparse writeln ] } { [ t ] [ "Unknown tlv: " write unparse writeln unscoped-stream get contents hexdump ] }
} cond } cond
] with-unscoped-stream ] with-unscoped-stream
] repeat ; ] repeat ;
@ -239,7 +284,7 @@ SYMBOL: buddy-list
{ [ dup 1 = ] [ drop " has entered text." writeln ] } { [ dup 1 = ] [ drop " has entered text." writeln ] }
{ [ dup 2 = ] [ drop " is typing..." writeln ] } { [ dup 2 = ] [ drop " is typing..." writeln ] }
{ [ t ] [ " does 4h.14h unknown: " write unparse writeln ] } { [ t ] [ " does 4h.14h unknown: " write unparse writeln ] }
} cond ; FAMILY: 4 OPCODE: 14 } cond ; FAMILY: 4 OPCODE: 20
: print-op ( op -- ) : print-op ( op -- )
"Op: " write . ; "Op: " write . ;
@ -264,7 +309,7 @@ SYMBOL: buddy-list
] unless ; ] unless ;
: handle-login-packet ( -- ) : handle-login-packet ( -- )
process-login-chunks ; FAMILY: 17 OPCODE: 3 process-login-chunks ; FAMILY: 23 OPCODE: 3
: password-md5 ( password -- md5 ) : password-md5 ( password -- md5 )
login-key get login-key get
@ -298,10 +343,9 @@ SYMBOL: buddy-list
HEX: 4a >short HEX: 01 >short client-ssi-flag >byte HEX: 4a >short HEX: 01 >short client-ssi-flag >byte
] send-aim ; ] send-aim ;
: handle-login-key-packet ( -- ) : handle-login-key-packet ( -- )
head-short head-string login-key set head-short head-string login-key set
respond-login-key-packet ; FAMILY: 17 OPCODE: 7 respond-login-key-packet ; FAMILY: 23 OPCODE: 7
: handle-packet ( packet -- ) : handle-packet ( packet -- )
<string-reader> <string-reader>
@ -320,6 +364,9 @@ SYMBOL: buddy-list
unscoped-stream get empty? [ incomplete-opcode ] unless unscoped-stream get empty? [ incomplete-opcode ] unless
] with-unscoped-stream ; ] with-unscoped-stream ;
! Commands ! Commands
: send-im ( name message -- ) : send-im ( name message -- )
message set message set
@ -440,6 +487,9 @@ SYMBOL: buddy-list
! modify-buddy ! modify-buddy
buddy-list-edit-stop ; buddy-list-edit-stop ;
! Login ! Login
: send-first-login ( -- ) : send-first-login ( -- )
[ 1 >int ] send-aim ; [ 1 >int ] send-aim ;

2
contrib/aim/net-bytes.factor
View File

@ -84,7 +84,7 @@ SYMBOL: unscoped-stack
swap dup unscoped-stream set unscoped-stack get push ; swap dup unscoped-stream set unscoped-stack get push ;
: set-previous-scope : set-previous-scope
! unscoped-stream get contents ! unscoped-stream get contents .
! [ ! [
! "UNREAD BYTES" writeln ! "UNREAD BYTES" writeln
! hexdump ! hexdump