"
(C) 2011-2014 by Holger Hans Peter Freyther
All Rights Reserved
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program 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 Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see .
"
PP.PPCompositeParser subclass: SIPGrammar [
| Response StatusLine message_header
CRLF SP HTAB HCOLON SWS LWS WSP COMMA SEMI SLASH COLON EQUAL
LAQUOT RAQUOT LDQUOT RDQUOT DQUOTE STAR URI
message_body SIPVersion StatusCode ReasonPhrase
extension_header header_name header_value
Request RequestLine Method extension_method
RequestURI quoted_string token commonUriParser paramchar
header generic_param tag_param digest_cln auth_param host
digitParser digitParserMin
|
"http://sofia-sip.org/repos/sofia-sip/libsofia-sip-ua/sip/GRAMMAR"
start [
^ Request / Response
]
digitParser [
^#digit asParser
]
digitParserMin [
^digitParser min: 1 max: 3
]
CRLF [
^ Character cr asParser, Character nl asParser
]
SP [
^ $ asParser
]
URI [
"TODO: URI should be parsed properly but yate seems to already
violate the RFC"
^(digitParser / #word asParser) star
"^absoluteURI / abs-path"
]
Request [
^ RequestLine, message_header star, CRLF, message_body optional
]
RequestLine [
^ Method, SP, RequestURI, SP, SIPVersion, CRLF
]
RequestURI [
"TODO: absoluteURI is not supported"
^ self SIPURI / self SIPSURI "/ self absoluteURI"
]
SIPURI [
^ 'sip:' asParser , commonUriParser
]
commonUriParser [
^self userinfo optional, self hostport, self uri_parameters,
self headers optional.
]
SIPSURI [
^ 'sips:' asParser , commonUriParser
]
hostport [
^ host, ($: asParser, self port) optional
]
host [
^ (PP.PPPredicateObjectParser on: (PP.PPCharSetPredicate on:
[:char | char isAlphaNumeric or: [
'.-' includes: char]]) message: 'host') plus flatten
]
port [
^ digitParser plus flatten
]
uri_parameters [
^ ($; asParser, self uri_parameter) star
]
uri_parameter [
"TODO: simplified"
^ self other_param
]
other_param [
^ self pname, ($= asParser, self pvalue) optional
]
pname [
^paramchar
]
pvalue [
^paramchar
]
paramchar [
^ (self param_unreserved / self unreserved / self escaped) plus flatten
]
param_unreserved [
^PP.PPPredicateObjectParser chars: '[]/:&+$' message: 'param_unreserved'.
]
headers [
^ $? asParser, header, ($& asParser, header) star
]
header [
^self hname, $= asParser, self hvalue
]
hname [
^ (self hnv_unreserved / self unreserved / self escaped) plus flatten
]
hvalue [
^ (self hnv_unreserved / self unreserved / self escaped) star flatten
]
hnv_unreserved [
^PP.PPPredicateObjectParser chars: '[]/?:+$' message: 'hnv_unreserved'
]
userinfo [
"telephone-subscriber not defined"
^ ( self user "/ self telephone_subscriber"),
($: asParser, self password) optional, $@ asParser
]
user [
^ (self unreserved / self escaped / self user_unreserved) plus flatten
]
user_unreserved [
^PP.PPPredicateObjectParser chars: '&=+$,;?/' message: 'user_unreserved'.
]
escaped [
"^ $% asParser, self HEXDIG, self HEXDIG"
^PP.PPPredicateObjectParser chars: '%0123456789abcdefABCDEF' message: 'escaped'.
]
HEXDIG [
^PP.PPPredicateObjectParser chars: '0123456789ABCDEF' message: 'hexdig expected'.
]
LHEX [
^PP.PPPredicateObjectParser chars: '0123456789abcdef' message: 'lhex expected'.
]
unreserved [
^ (#letter asParser / digitParser) / self mark
]
reserved [
^PP.PPPredicateObjectParser chars: ';/?:@&=+$,' message: 'reserved'.
]
mark [
^PP.PPPredicateObjectParser chars: '-_.!~*''()' message: 'mark'.
]
password [
^ ( self unreserved / self escaped / $& asParser /
$= asParser / $+ asParser / $$ asParser / $, asParser) star
]
Method [
^ 'INVITE' asParser /
'ACK' asParser /
'OPTIONS' asParser /
'BYE' asParser /
'CANCEL' asParser /
'REGISTER' asParser /
extension_method
]
extension_method [
^token
]
Response [
^ StatusLine, message_header star, CRLF, message_body optional
]
StatusLine [
^ SIPVersion, SP, StatusCode, SP, ReasonPhrase, CRLF
]
SIPVersion [
^ 'SIP/2.0' asParser
]
StatusCode [
"Combined into one..."
^ (digitParser min: 3 max: 3) flatten
]
ReasonPhrase [
^ (self reserved / self unreserved / self escaped /
SP / HTAB / #letter asParser) star flatten
]
message_header [
"Simplified..."
^ (self Via / self CSeq / self From /
self To / self Contact / self WWWAuthenticate / self ProxyAuthenticate /
self Authorization / self ProxyAuthorization / extension_header), CRLF
]
message_body [
^ #any asParser plus flatten
]
Via [
^ ( 'Via' asParser / 'v' asParser), HCOLON,
self via_parm, (COMMA, self via_parm) star
]
via_parm [
^ self sent_protocol, LWS, self sent_by, (SEMI, self via_params) star
]
via_params [
^ self via_ttl / self via_maddr / self via_received /
self via_branch / self response_port / self via_extension
]
via_ttl [
^ 'ttl' asParser, EQUAL, self ttl
]
via_maddr [
^ 'maadr' asParser, EQUAL, host
]
via_received [
"TODO: IPv6 support is missing"
^ 'received' asParser, EQUAL, (self IPv4address)
]
via_branch [
^ 'branch' asParser, EQUAL, token
]
via_extension [
^generic_param
]
response_port [
^'rport' asParser, (EQUAL, digitParser plus) optional
]
ttl [
^ digitParserMin
]
IPv4address [
| dotParser |
dotParser := $. asParser.
^ (digitParserMin), dotParser,
(digitParserMin), dotParser,
(digitParserMin), dotParser,
(digitParserMin).
]
CSeq [
^ 'CSeq' asParser, HCOLON, (digitParser plus flatten, LWS, Method)
]
generic_param [
^ token, (EQUAL, self gen_value) optional
]
gen_value [
^token / host / quoted_string
]
quoted_string [
^SIPQuotedStringParser new
]
qdtext [
| str |
"TODO: UTF-8 text is not working properly..."
str := WriteStream on: (String new).
str nextPut: (Character value: 16r21).
16r23 to: 16r5B do: [:each | str nextPut: (Character value: each)].
16r5D to: 16r7E do: [:each | str nextPut: (Character value: each)].
^ LWS / (PP.PPPredicateObjectParser chars: str contents message: 'qdtext') "/ UTF8_NONASCII"
]
quoted_pair [
| str |
str := WriteStream on: (String new).
str nextPut: (Character value: 16r21).
16r00 to: 16r09 do: [:each | str nextPut: (Character value: each)].
16r0B to: 16r0C do: [:each | str nextPut: (Character value: each)].
16r5D to: 16r7E do: [:each | str nextPut: (Character value: each)].
^ '\' asParser, (PP.PPPredicateObjectParser chars: str contents message: 'quoted_pair')
]
sent_protocol [
^ self protocol_name, SLASH, self protocol_version, SLASH, self transport
]
sent_by [
^ host, (COLON, self port) optional
]
protocol_name [
^ 'SIP' asParser / token.
]
protocol_version [
^token
]
transport [
^ 'UDP' asParser / 'TCP' asParser / 'TLS' asParser /
'SCTP' asParser / self other_transport
]
other_transport [
^token
]
From [
^ ('From' asParser / 'f' asParser), HCOLON, self from_spec
]
from_spec [
^ (self name_addr / self addr_spec), (SEMI, self from_param) star
]
from_param [
^tag_param / generic_param
]
To [
^ ('To' asParser / $t asParser), HCOLON, self to_spec
]
to_spec [
"I do not exist in the RFC but I make things more beautiful and
symmetric with the From case"
^ (self name_addr / self addr_spec), (SEMI, self to_param) star
]
to_param [
^tag_param / generic_param
]
tag_param [
^ 'tag' asParser, EQUAL, token
]
name_addr [
^ self display_name optional, LAQUOT, self addr_spec, RAQUOT
]
display_name [
^ (quoted_string / (token, LWS) star) flatten
]
addr_spec [
"TODO: absoluteURI is not supported"
^ self SIPURI / self SIPSURI "/ self absoluteURI"
]
Contact [
^ ('Contact' asParser / 'm' asParser), HCOLON,
(STAR / (self contact_param, (COMMA, self contact_param) star))
]
Authorization [
^'Authorization' asParser, HCOLON, self credentials
]
credentials [
^('Digest' asParser, LWS, self digest_response) / self other_response
]
digest_response [
^self dig_resp, (COMMA, self dig_resp) star
]
dig_resp [
^self username / self realm / self nonce / self digest_uri /
self dresponse / self algorithm / self cnonce / self opaque /
self message_qop / self nonce_count / auth_param
]
username [
^'username' asParser, EQUAL, quoted_string
]
digest_uri [
^'uri' asParser, EQUAL, LDQUOT, self digest_uri_value, RDQUOT
]
digest_uri_value [
^RequestURI
]
message_qop [
^'qop' asParser, EQUAL, self qop_value flatten
]
cnonce [
^'cnonce' asParser, EQUAL, self nonce_value
]
nonce_count [
^'nc' asParser, EQUAL, (self LHEX min: 8 max: 8) flatten
]
dresponse [
^'response' asParser , EQUAL , self request_digest
]
request_digest [
^LDQUOT, (self LHEX min: 32 max: 32) flatten, RDQUOT
]
WWWAuthenticate [
^'WWW-Authenticate' asParser, HCOLON, self challenge
]
challenge [
^('Digest' asParser trim, (digest_cln separatedBy: COMMA)) /
self other_challenge
]
digest_cln [
^self realm / self domain / self nonce / self opaque /
self stale / self algorithm / self qop_options / auth_param
]
other_challenge [
^self auth_scheme trim, (auth_param separatedBy: COMMA)
]
realm [
^'realm' asParser, EQUAL, self realm_value
]
realm_value [
^quoted_string
]
domain [
^'domain' asParser, EQUAL, LDQUOT, URI, (SP plus, URI) star, RDQUOT
]
nonce [
^'nonce' asParser, EQUAL, self nonce_value
]
nonce_value [
^quoted_string
]
opaque [
^'opaque' asParser, EQUAL, quoted_string
]
stale [
^'stale' asParser, EQUAL, ('true' asParser caseInsensitive / 'false' asParser caseInsensitive)
]
algorithm [
^'algorithm' asParser, EQUAL, ('MD5' asParser / 'MD5-sess' asParser / token)
]
qop_options [
| qop_value |
qop_value := self qop_value flatten.
^ 'qop' asParser, EQUAL, LDQUOT, qop_value, ($, asParser, qop_value) star, RDQUOT
]
qop_value [
^'auth' asParser / 'auth-init' asParser / token
]
auth_param [
"think of auth_param_name here instead of token"
^token, EQUAL, (token / quoted_string)
]
other_response [
^self auth_scheme, LWS, auth_param, (COMMA, auth_param) plus
]
auth_scheme [
^token
]
ProxyAuthenticate [
^'Proxy-Authenticate' asParser, HCOLON, self challenge
]
ProxyAuthorization [
^'Proxy-Authorization' asParser, HCOLON, self credentials
]
contact_param [
^ (self name_addr / self addr_spec), (SEMI, self contact_params) star
]
contact_params [
^ self c_p_q / self c_p_expires / self contact_extension
]
c_p_q [
^ $q asParser, EQUAL, self qvalue
]
c_p_expires [
^ 'expires' asParser, EQUAL, self delta_seconds
]
contact_extension [
^generic_param
]
delta_seconds [
^ digitParser plus
]
extension_header [
^ header_name, HCOLON, header_value
]
qvalue [
^ ($0 asParser, ($. asParser, digitParser max: 3) optional) /
($1 asParser, ($. asParser, $0 asParser max: 3) optional)
]
token [
^ (PP.PPPredicateObjectParser on: (PP.PPCharSetPredicate on:
[:char | char isAlphaNumeric or: [
'-.!%*_+`''~' includes: char]]) message: 'token') plus flatten
]
header_name [
"hmm 1*() should be optional but it must be star here"
^token
]
header_value [
"TODO: TEXT-UTF8char / UTF8-CONT"
^ (#letter asParser / digitParser / #punctuation asParser / #blank asParser / LWS) star flatten
]
HTAB [
^ Character tab asParser
]
HCOLON [
^ (SP / HTAB) star, $: asParser trim
]
WSP [
^ #blank asParser
]
LWS [
^ (WSP star, CRLF) optional, WSP plus
]
COMMA [
^ $, asParser trim
]
SEMI [
^ $; asParser trim
]
SLASH [
^ $/ asParser trim
]
COLON [
^ $: asParser trim
]
EQUAL [
^ $= asParser trim
]
SWS [
^ LWS optional
]
LAQUOT [
^ SWS, $< asParser
]
RAQUOT [
^ $> asParser, SWS
]
LDQUOT [
^ SWS, DQUOTE
]
RDQUOT [
^ DQUOTE, SWS
]
DQUOTE [
^ $" asParser
]
STAR [
^$* asParser trim
]
]