smalltalk
/
osmo-st-sip
Archived
1
0
Fork 0
This repository has been archived on 2022-02-17. You can view files and clone it, but cannot push or open issues or pull requests.
osmo-st-sip/grammar/SIPGrammar.st

813 lines
20 KiB
Smalltalk

"
(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 <http://www.gnu.org/licenses/>.
"
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
message_body SIPVersion StatusCode ReasonPhrase
extension_header header_name header_value
Request RequestLine Method extension_method
RequestURI
|
"http://sofia-sip.org/repos/sofia-sip/libsofia-sip-ua/sip/GRAMMAR"
<category: 'OsmoSIP-Grammar'>
<comment: 'I try to parse RFC3261'>
start [
<category: 'start'>
^ Request / Response
]
CRLF [
<category: 'misc'>
^ Character cr asParser, Character nl asParser
]
SP [
<category: 'misc'>
^ $ asParser
]
Request [
<category: 'request'>
^ RequestLine, message_header star, CRLF, message_body optional
]
RequestLine [
<category: 'request'>
^ Method, SP, RequestURI, SP, SIPVersion, CRLF
]
RequestURI [
<category: 'request'>
"TODO: absoluteURI is not supported"
^ self SIPURI / self SIPSURI "/ self absoluteURI"
]
SIPURI [
<category: 'request'>
^ 'sip:' asParser , self userinfo optional,
self hostport, self uri_parameters, self headers optional.
]
SIPSURI [
<category: 'request'>
^ 'sips:' asParser , self userinfo optional,
self hostport, self uri_parameters, self headers optional.
]
hostport [
<category: 'generic'>
^ self host, ($: asParser, self port) optional
]
host [
<category: 'generic'>
"TODO: too simplieified"
^ (#letter asParser / #digit asParser / $. asParser / $- asParser) plus flatten
]
port [
<category: 'generic'>
^ #digit asParser plus flatten
]
uri_parameters [
<category: 'generic'>
^ ($; asParser, self uri_parameter) star
]
uri_parameter [
<category: 'generic'>
"TODO: simplified"
^ self other_param
]
other_param [
<category: 'generic'>
^ self pname, ($= asParser, self pvalue) optional
]
pname [
<category: 'generic'>
^ self paramchar plus flatten
]
pvalue [
<category: 'generic'>
^ self paramchar plus flatten
]
paramchar [
<category: 'generic'>
^ self param_unreserved / self unreserved / self escaped
]
param_unreserved [
<category: 'generic'>
^ $[ asParser / $] asParser / $/ asParser / $: asParser /
$& asParser / $+ asParser / $$ asParser.
]
headers [
<category: 'generic'>
^ $? asParser, self header, ($& asParser, self header) star
]
header [
<category: 'generic'>
^ self hname, $= asParser, self hvalue
]
hname [
<category: 'generic'>
^ (self hnv_unreserved / self unreserved / self escaped) plus flatten
]
hvalue [
<category: 'generic'>
^ (self hnv_unreserved / self unreserved / self escaped) star flatten
]
hnv_unreserved [
<category: 'generic'>
^ $[ asParser / $] asParser / $/ asParser / $? asParser /
$: asParser / $+ asParser / $$ asParser.
]
userinfo [
<category: 'generic'>
"telephone-subscriber not defined"
^ ( self user "/ self telephone_subscriber"),
($: asParser, self password) optional, $@ asParser
]
user [
<category: 'generic'>
^ (self unreserved / self escaped / self user_unreserved) plus flatten
]
user_unreserved [
<category: 'generic'>
^ $& asParser / $= asParser / $+ asParser / $$ asParser / $, asParser / $; asParser / $? asParser / $/ asParser
]
escaped [
<category: 'generic'>
^ $% asParser, self HEXDIG, self HEXDIG
]
HEXDIG [
<category: 'RFC5234'>
^ #digit asParser / $A asParser / $B asParser / $C asParser /
$D asParser / $E asParser / $F asParser
]
LHEX [
^ #digit asParser / $a asParser / $b asParser / $c asParser /
$d asParser / $e asParser / $f asParser
]
unreserved [
<category: 'generic'>
^ (#letter asParser / #digit asParser) / self mark
]
reserved [
<category: 'generic'>
^ ($; asParser / $/ asParser / $? asParser / $: asParser /
$@ asParser / $& asParser / $= asParser / $+ asParser /
$$ asParser / $, asParser)
]
mark [
^ $- asParser / $_ asParser / $. asParser / $! asParser / $~ asParser /
$* asParser / $' asParser / $( asParser / $) asParser
]
password [
<category: 'request'>
^ ( self unreserved / self escaped / $& asParser /
$= asParser / $+ asParser / $$ asParser / $, asParser) star
]
Method [
<category: 'request'>
^ 'INVITE' asParser /
'ACK' asParser /
'OPTIONS' asParser /
'BYE' asParser /
'CANCEL' asParser /
'REGISTER' asParser /
extension_method
]
extension_method [
^ self token
]
Response [
<category: 'response'>
^ StatusLine, message_header star, CRLF, message_body optional
]
StatusLine [
<category: 'response'>
^ SIPVersion, SP, StatusCode, SP, ReasonPhrase, CRLF
]
SIPVersion [
<category: 'generic'>
^ 'SIP/' asParser, #digit asParser, $. asParser, #digit asParser
]
StatusCode [
<category: 'response'>
"Combined into one..."
^ '100' asParser / "Trying"
'101' asParser / "Early Dialog.. of Linphone"
'180' asParser / "Ringing"
'181' asParser / "Call Is Being Forwarded"
'182' asParser / "Queued"
'183' asParser / "Session Progress"
'200' asParser / "OK"
'300' asParser / "Multiple Choices"
'301' asParser / "Moved Permanently"
'302' asParser / "Moved Temporarily"
'380' asParser / "Alternative Service"
'400' asParser / "Bad Request"
'401' asParser / "Unauthorized"
'402' asParser / "Payment Required"
'403' asParser / "Forbidden"
'404' asParser / "Not Found"
'405' asParser / "Method Not Allowed"
'406' asParser / "Not Acceptable"
'407' asParser / "Proxy Authentication Required"
'408' asParser / "Request Timeout"
'410' asParser / "Gone"
'413' asParser / "Request Entity Too Large"
'414' asParser / "Request-URI Too Large"
'415' asParser / "Unsupported Media Type"
'416' asParser / "Unsupported URI Scheme"
'420' asParser / "Bad Extension"
'421' asParser / "Extension Required"
'423' asParser / "Interval Too Brief"
'480' asParser / "Temporarily not available"
'481' asParser / "Call Leg/Transaction Does Not Exist"
'482' asParser / "Loop Detected"
'483' asParser / "Too Many Hops"
'484' asParser / "Address Incomplete"
'485' asParser / "Ambiguous"
'486' asParser / "Busy Here"
'487' asParser / "Request Terminated"
'488' asParser / "Not Acceptable Here"
'491' asParser / "Request Pending"
'493' asParser / "Undecipherable"
'500' asParser / "Internal Server Error"
'501' asParser / "Not Implemented"
'502' asParser / "Bad Gateway"
'503' asParser / "Service Unavailable"
'504' asParser / "Server Time-out"
'505' asParser / "SIP Version not supported"
'513' asParser / "Message Too Large"
'600' asParser / "Busy Everywhere"
'603' asParser /"Decline"
'604' asParser /"Does not exist anywhere"
'606' asParser "Not Acceptable"
]
ReasonPhrase [
<category: 'response'>
^ (self reserved / self unreserved / self escaped /
SP / HTAB / #letter asParser) star flatten
]
message_header [
"Simplified..."
<category: 'generic'>
^ (self Via / self CSeq / self From /
self To / self Contact / self WWWAuthenticate / self Authorization /
extension_header), CRLF
]
message_body [
^ #any asParser plus flatten
]
Via [
<category: 'via'>
^ ( 'Via' asParser / 'v' asParser), self HCOLON,
self via_parm, (COMMA, self via_parm) star
]
via_parm [
<category: 'via'>
^ self sent_protocol, LWS, self sent_by, (SEMI, self via_params) star
]
via_params [
<category: 'via'>
^ self via_ttl / self via_maddr / self via_received /
self via_branch / self response_port / self via_extension
]
via_ttl [
<category: 'via'>
^ 'ttl' asParser, EQUAL, self ttl
]
via_maddr [
<category: 'via'>
^ 'maadr' asParser, EQUAL, self host
]
via_received [
<category: 'via'>
"TODO: IPv6 support is missing"
^ 'received' asParser, EQUAL, (self IPv4address)
]
via_branch [
<category: 'via'>
^ 'branch' asParser, EQUAL, self token
]
via_extension [
<category: 'via'>
^ self generic_param
]
response_port [
<category: 'via'>
^'rport' asParser, (EQUAL, #digit asParser plus) optional
]
ttl [
<category: 'generic'>
^ #digit asParser min: 1 max: 3
]
IPv4address [
^ (#digit asParser min: 1 max: 3), $. asParser,
(#digit asParser min: 1 max: 3), $. asParser,
(#digit asParser min: 1 max: 3), $. asParser,
(#digit asParser min: 1 max: 3).
]
CSeq [
<category: 'cseq'>
^ 'CSeq' asParser, HCOLON, (#digit asParser plus flatten, LWS, self Method)
]
generic_param [
<category: 'generic'>
^ self token, (EQUAL, self gen_value) optional
]
gen_value [
<category: 'generic'>
^ self token / self host / self quoted_string
]
quoted_string [
<category: 'generic'>
^ self SWS, DQUOTE, (self qdtext / self quoted_pair) star flatten, DQUOTE
]
qdtext [
| str |
<category: 'generic'>
"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 |
<category: 'generic'>
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 [
<category: 'via'>
^ self protocol_name, SLASH, self protocol_version, SLASH, self transport
]
sent_by [
<category: 'via'>
^ self host, (COLON, self port) optional
]
protocol_name [
<category: 'via'>
^ 'SIP' asParser / self token.
]
protocol_version [
<category: 'via'>
^ self token
]
transport [
<category: 'via'>
^ 'UDP' asParser / 'TCP' asParser / 'TLS' asParser /
'SCTP' asParser / self other_transport
]
other_transport [
<category: 'via'>
^ self token
]
From [
<category: 'from'>
^ ('From' asParser / 'f' asParser), HCOLON, self from_spec
]
from_spec [
<category: 'from'>
^ (self name_addr / self addr_spec), (SEMI, self from_param) star
]
from_param [
<category: 'from'>
^ self tag_param / self generic_param
]
To [
<category: '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"
<category: 'to'>
^ (self name_addr / self addr_spec), (SEMI, self to_param) star
]
to_param [
<category: 'to'>
^ self tag_param / self generic_param
]
tag_param [
<category: 'to'>
^ 'tag' asParser, EQUAL, self token
]
name_addr [
<category: 'to-from'>
^ self display_name optional, LAQUOT, self addr_spec, self RAQUOT
]
display_name [
<category: 'to-from'>
^ ((self token, LWS) star / self quoted_string) flatten
]
addr_spec [
<category: 'to-from'>
"TODO: absoluteURI is not supported"
^ self SIPURI / self SIPSURI "/ self absoluteURI"
]
Contact [
<category: 'contact'>
^ ('Contact' asParser / 'm' asParser), HCOLON,
(STAR / (self contact_param, (COMMA, self contact_param) star))
]
Authorization [
<category: 'WWW-Authenticate'>
^'Authorization' asParser, HCOLON, self credentials
]
credentials [
<category: 'WWW-Authenticate'>
^('Digest' asParser, LWS, self digest_response) / self other_response
]
digest_response [
<category: 'WWW-Authenticate'>
^self dig_resp, (COMMA, self dig_resp) star
]
dig_resp [
<category: 'WWW-Authenticate'>
^self username / self realm / self nonce / self digest_uri /
self dresponse / self algorithm / self cnonce / self opaque /
self message_qop / self nonce_count / self auth_param
]
username [
<category: 'WWW-Authenticate'>
^'username' asParser, EQUAL, self quoted_string
]
digest_uri [
<category: 'WWW-Authenticate'>
^'uri' asParser, EQUAL, LDQUOT, self digest_uri_value, RDQUOT
]
digest_uri_value [
<category: 'WWW-Authenticate'>
^RequestURI
]
message_qop [
<category: 'WWW-Authenticate'>
^'qop' asParser, EQUAL, self qop_value
]
cnonce [
<category: 'WWW-Authenticate'>
^'cnonce' asParser, EQUAL, self nonce_value
]
nonce_count [
<category: 'WWW-Authenticate'>
^'nc' asParser, EQUAL, (self LHEX min: 8 max: 8) flatten
]
dresponse [
<category: 'WWW-Authenticate'>
^'response' asParser , EQUAL , self request_digest
]
request_digest [
<category: 'WWW-Authenticate'>
^LDQUOT, (self LHEX min: 32 max: 32) flatten, RDQUOT
]
WWWAuthenticate [
<category: 'WWW-Authenticate'>
^'WWW-Authenticate' asParser, HCOLON, self challenge
]
challenge [
<category: 'WWW-Authenticate'>
^('Digest' asParser, LWS, self digest_cln, (COMMA, self digest_cln) star) /
self other_challenge
]
digest_cln [
<category: 'WWW-Authenticate'>
^self realm / self domain / self nonce / self opaque /
self stale / self algorithm / self qop_options / self auth_param
]
other_challenge [
<category: 'WWW-Authenticate'>
^self auth_scheme, LWS, self auth_param, (COMMA, self auth_param) star
]
realm [
<category: 'WWW-Authenticate'>
^'realm' asParser, EQUAL, self realm_value
]
realm_value [
<category: 'WWW-Authenticate'>
^self quoted_string
]
domain [
<category: 'WWW-Authenticate'>
^'domain' asParser, EQUAL, LDQUOT, URI, (SP plus, URI) star, RDQUOT
]
nonce [
<category: 'WWW-Authenticate'>
^'nonce' asParser, EQUAL, self nonce_value
]
nonce_value [
<category: 'WWW-Authenticate'>
^self quoted_string
]
opaque [
<category: 'WWW-Authenticate'>
^'opaque' asParser, EQUAL, self quoted_string
]
stale [
<category: 'WWW-Authenticate'>
^'stale' asParser, EQUAL, ('true' asParser caseInsensitive / 'false' asParser caseInsensitive)
]
algorithm [
<category: 'WWW-Authenticate'>
^'algorithm' asParser, EQUAL, ('MD5' asParser / 'MD5-sess' asParser / self token)
]
qop_options [
| qop_value |
<category: 'WWW-Authenticate'>
qop_value := self qop_value.
^ 'qop' asParser, EQUAL, LDQUOT, qop_value, ($, asParser, qop_value) star, RDQUOT
]
qop_value [
<category: 'WWW-Authenticate'>
^'auth' asParser / 'auth-init' asParser / self token
]
auth_param [
<category: 'WWW-Authenticate'>
^self auth_param_name, EQUAL, (self token / self quoted_string)
]
auth_param_name [
<category: 'WWW-Authenticate'>
^self token
]
other_response [
<category: 'WWW-Authenticate'>
^self auth_scheme, LWS, self auth_param, (COMMA, self auth_param) plus
]
auth_scheme [
<category: 'WWW-Authenticate'>
^self token
]
contact_param [
<category: 'contact'>
^ (self name_addr / self addr_spec), (SEMI, self contact_params) star
]
contact_params [
<category: 'contact'>
^ self c_p_q / self c_p_expires / self contact_extension
]
c_p_q [
<category: 'contact'>
^ $q asParser, EQUAL, self qvalue
]
c_p_expires [
<category: 'contact'>
^ 'expires' asParser, EQUAL, self delta_seconds
]
contact_extension [
<category: 'contact'>
^ self generic_param
]
delta_seconds [
<category: 'contact'>
^ #digit asParser plus
]
extension_header [
<category: 'generic'>
^ header_name, HCOLON, header_value
]
qvalue [
<category: 'generic'>
^ ($0 asParser, ($. asParser, #digit asParser max: 3) optional) /
($1 asParser, ($. asParser, $0 asParser max: 3) optional)
]
token [
<category: 'generic'>
^ (#letter asParser / #digit asParser /
$- asParser / $. asParser /
$! asParser / $% asParser /
$* asParser / $_ asParser /
$+ asParser / $` asParser /
$' asParser / $~ asParser) star flatten
]
header_name [
<category: 'generic'>
"hmm 1*() should be optional but it must be star here"
^ self token
]
header_value [
<category: 'generic'>
"TODO: TEXT-UTF8char / UTF8-CONT"
^ (#letter asParser / #digit asParser / #punctuation asParser / #blank asParser / LWS) star flatten
]
HTAB [
<category: 'generic'>
^ Character tab asParser
]
HCOLON [
<category: 'generic'>
^ (SP / HTAB) star, $: asParser, SWS
]
WSP [
<category: 'misc'>
^ #blank asParser
]
LWS [
<category: 'generic'>
^ (WSP star, CRLF) optional, WSP plus
]
COMMA [
<category: 'generic'>
^ SWS, $, asParser, SWS
]
SEMI [
<category: 'generic'>
^ SWS, $; asParser, SWS
]
SLASH [
<category: 'generic'>
^ SWS, $/ asParser, SWS
]
COLON [
<category: 'generic'>
^ SWS, $: asParser, SWS
]
EQUAL [
<category: 'generic'>
^ (SWS, $= asParser, SWS)
]
SWS [
<category: 'generic'>
^ LWS optional
]
LAQUOT [
<category: 'generic'>
^ SWS, $< asParser
]
RAQUOT [
<category: 'generic'>
^ $> asParser, SWS
]
LDQUOT [
<category: 'generic'>
^ SWS, DQUOTE
]
RDQUOT [
<category: 'generic'>
^ DQUOTE, SWS
]
DQUOTE [
<category: 'generic'>
^ $" asParser
]
STAR [
<category: 'generic'>
^ SWS, $* asParser, SWS
]
]