Source

ocaml-sip / src / Sip_types.ml

Full commit
open Batteries;;

(***************************************************************************************************)
(* DATA TYPE *)


type sip_request_method
    = REGISTER
    | INVITE
    | CANCEL
    | ACK
    | PRACK
    | BYE
    | OPTIONS
    | SUBSCRIBE
    | NOTIFY
    | PUBLISH
    | INFO
    | REFER
    | MESSAGE
    | UPDATE
    | UnknownRequestMethod of string

let sip_request_method_of_string = function
    | "REGISTER" -> REGISTER
    | "INVITE" -> INVITE
    | "CANCEL" -> CANCEL
    | "ACK" -> ACK
    | "PRACK" -> PRACK
    | "BYE" -> BYE
    | "OPTIONS" -> OPTIONS
    | s -> UnknownRequestMethod s


type sip_response_code
    = RESP_100_TRYING
    | RESP_180_RINGING
    | RESP_181_CALL_IS_BEING_FORWARDED
    | RESP_182_QUEUED
    | RESP_183_SESSION_IN_PROGRESS

    | RESP_200_OK
    | RESP_202_ACCEPTED
    | RESP_204_NO_NOTIFICATION

    | RESP_300_MULTIPLE_CHOICES
    | RESP_301_MOVED_PERMANENTLY
    | RESP_302_MOVED_TEMPORILY
    | RESP_305_USE_PROXY
    | RESP_380_ALTERNATIVE_SERVICE

    | RESP_400_BAD_REQUEST
    | RESP_401_UNAUTHORIZED
    | RESP_402_PAYMENT_REQUIRED
    | RESP_403_FORBIDDEN
    | RESP_404_NOT_FOUND
    | RESP_405_METHOD_NOT_ALLOWED

    | RESP_500_SERVER_INTERNAL_ERROR
    | RESP_501_NOT_IMPLEMENTED
    | RESP_502_BAD_GATEWAY
    | RESP_503_SERVICE_UNAVAILABLE

    | RESP_600_BUSY_EVERYWHERE

    | OtherResponse of int


let int_of_response_code = function
    | RESP_100_TRYING -> 100
    | RESP_180_RINGING -> 180
    | RESP_181_CALL_IS_BEING_FORWARDED -> 181
    | RESP_182_QUEUED -> 182
    | RESP_183_SESSION_IN_PROGRESS -> 183

    | RESP_200_OK -> 200
    | RESP_202_ACCEPTED -> 202
    | RESP_204_NO_NOTIFICATION -> 204

    | RESP_300_MULTIPLE_CHOICES -> 300
    | RESP_301_MOVED_PERMANENTLY -> 301
    | RESP_302_MOVED_TEMPORILY -> 302
    | RESP_305_USE_PROXY -> 305
    | RESP_380_ALTERNATIVE_SERVICE -> 380

    | RESP_400_BAD_REQUEST -> 400
    | RESP_401_UNAUTHORIZED -> 401
    | RESP_402_PAYMENT_REQUIRED -> 402
    | RESP_403_FORBIDDEN -> 403
    | RESP_404_NOT_FOUND -> 404
    | RESP_405_METHOD_NOT_ALLOWED -> 405

    | RESP_500_SERVER_INTERNAL_ERROR -> 500
    | RESP_501_NOT_IMPLEMENTED -> 501
    | RESP_502_BAD_GATEWAY -> 502
    | RESP_503_SERVICE_UNAVAILABLE -> 503

    | RESP_600_BUSY_EVERYWHERE -> 600

    | OtherResponse i -> i

type sip_login =
    SipLogin of string

type sip_host = 
    SipHost of string

type sip_uri =
    SipUri of string

type sip_address =
    SipAddress of string * sip_uri

type sip_callid =
    SipCallId of string

type sip_cseq =
    SipCseq of string

type sip_contact =
    SipContact of string

type sip_version =
    | SIP_1_0
    | SIP_2_0
    | UnknownSipVersion of string

let sip_version_of_string = function
    | "SIP/1.0" -> SIP_1_0
    | "SIP/2.0" -> SIP_2_0
    | sipver    -> UnknownSipVersion sipver

class sip_request _reqmethod _uri _version mime =

        let reqmethod      = sip_request_method_of_string _reqmethod in

        let content_length = int_of_string (Hashtbl.find mime "content-length") in

        let addr_from      = SipUri (Hashtbl.find mime "from") in

        let addr_to        = SipUri (Hashtbl.find mime "to") in

        let call_id        = SipCallId (Hashtbl.find mime "call-id") in

        let cseq           = SipCseq (Hashtbl.find mime "cseq") in

        let vias           = Hashtbl.find_all mime "via" in

        let version        = sip_version_of_string _version in

        let uri            = SipUri _uri in

        let sip_contact    = SipContact (Hashtbl.find mime "contact") in

        let max_forwards   = int_of_string (Hashtbl.find mime "max-forwards") in

    object
        val mime                = mime

        method sip_method       = reqmethod

        method sip_uri          = uri

        method sip_version      = version

        method content_length   = content_length

        method addr_to          = addr_to

        method addr_from        = addr_from

        method vias             = vias

        method call_id          = call_id

        method cseq             = cseq

        method max_forwards     = max_forwards

        method contact          = sip_contact

        method header name      = Hashtbl.find mime name

        method headers name     = Hashtbl.find_all mime name
    end


(***************************************************************************************************)
(* PARSER, unsafe *)

exception Invalid_sip_message

let eol_sep = "\r\n"

let is_sep seps = function
    | c when List.mem c seps -> true
    | _ -> false

let rec skip_seps seps buf = function
    | n when n = String.length buf ->
        n

    | n when is_sep seps (String.get buf n) ->
        skip_seps seps buf (succ n)

    | n ->
        n

let find_sep seps start buf =
    let rec find_end start = function
        | n when n = String.length buf ->
            (String.slice buf ~first:start ~last:n, n)

        | n when is_sep seps (String.get buf n) ->
            (String.slice buf ~first:start ~last:n, n)

        | n ->
            find_end start (succ n)

        in

    let remember_arg f x = f x x 
        in
    (remember_arg find_end -| skip_seps seps buf) start

let find_word = find_sep [' '; '\r'; '\n'] 

let find_endline index buf =
    let last = String.find_from buf index eol_sep in
    (String.slice buf ~first:index ~last:last, succ (succ last))

let parse_request_method buffer = 
    let (strmethod, last) = find_word 0 buffer in
    (sip_request_method_of_string strmethod, last)

let parse_request_line buffer =
    let (reqmethod, last) = find_word 0    buffer in
    let (uri,       last) = find_word last buffer in
    let (ver,       last) = find_word last buffer in
    let (_,         last) = find_endline last buffer in
    (reqmethod, uri, ver, last)

let parse_mime buffer =
    let htable = Hashtbl.create 27 in

    let parse_entry first =
        let seps          = [' '; '\r'; '\n'; ':'] in
        let (name,  last) = find_sep seps first buffer in
        let (       last) = skip_seps seps buffer last in
        let (value, last) = find_endline last buffer in
        (name, value, last)
        in

    let rec parse_lines last =
        let (line, _) = find_endline last buffer in
        if String.length line == 0 
        then
            (htable, last + 2)
        else
            let (name, value, last) = parse_entry last in
            Hashtbl.add htable (String.lowercase name) value;
            parse_lines last
        in

    parse_lines

let early_parse_request buffer =
    try 
        let (reqmethod, uri, sipver, last) = parse_request_line buffer in
        let (mime, last)                   = parse_mime buffer last in
        (reqmethod, uri, sipver, mime, last)
    with
        Not_found | Invalid_argument _ ->
            raise Invalid_sip_message

let parse_request buffer =
    let (reqmethod, uri, sipver, mime, last) = early_parse_request buffer in
    try
        new sip_request reqmethod uri sipver mime
    with
        Not_found | Failure _ ->
            raise Invalid_sip_message

let test1 = 
    "INVITE sip2 SIP/2.0\r\n" ^
    "A: 20\r\n" ^
    "B: 30\r\n" ^
    "C: 40\r\n" ^
    "\r\n" ^
    "Content" 


let test2 =
      "INVITE sip:bob@biloxi.com SIP/2.0" ^ eol_sep ^
      "Via: SIP/2.0/UDP pc33.atlanta.com;branch=z9hG4bK776asdhds" ^ eol_sep ^
      "Max-Forwards: 70" ^ eol_sep ^
      "To: Bob <sip:bob@biloxi.com>" ^ eol_sep ^
      "From: Alice <sip:alice@atlanta.com>;tag=1928301774" ^ eol_sep ^
      "Call-ID: a84b4c76e66710@pc33.atlanta.com" ^ eol_sep ^
      "CSeq: 314159 INVITE" ^ eol_sep ^
      "Contact: <sip:alice@pc33.atlanta.com>" ^ eol_sep ^
      "Content-Type: application/sdp" ^ eol_sep ^
      "Content-Length: 142" ^ eol_sep ^
      eol_sep ^
      "blaa"