Source

ocaml-sip / src / Sip_parser.ml

(*********************************************************************************************************************
 * Copyrights (C) 2012 by Pawel Wieczorek <wieczyk at gmail>
 *  http://bitbucket.org/wieczyk/ocaml-sip
 *)

open Batteries
open Sip_utils
open Sip_types

(********************************************************************************************************************
 * Parsed request and response
 *)

class parsed_sip_request _reqmethod _uri _version mime : sip_request =

        (* compute and extract required informations *)

        let reqmethod      = sip_request_method_of_string _reqmethod in

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

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

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

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

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

        let vias           = Hashtbl.find_all mime "via" in

        let version        = sip_version_of_string _version in

        let uri            = sip_uri_of_string _uri in

        let sip_contact    = Option.map sip_address_of_string (Hashtbl.find_option mime "contact") in

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

        (* construct object *)

    object

        val mime                = mime

        method sip_method       = reqmethod

        method sip_version      = version

        method uri              = uri

        method content_length   = content_length

        method addr_to          = addr_to

        method addr_from        = addr_from

        method vias             = List.map sip_via_of_string 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 header_option name = Hashtbl.find_option mime name

        method header_all name  = Hashtbl.find_all mime name

    end

class parsed_sip_response _response msg _version mime : sip_response =

        (* compute and extract required informations *)

        let response       = sip_response_code_of_string (int_of_string _response) in

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

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

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

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

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

        let vias           = Hashtbl.find_all mime "via" in

        let version        = sip_version_of_string _version in

        let sip_contact    = Option.map sip_address_of_string (Hashtbl.find_option mime "contact") in

        (* construct object *)

    object

        val mime                = mime

        method sip_response_code = response

        method sip_response_message = msg

        method sip_version      = version

        method content_length   = content_length

        method addr_to          = addr_to

        method addr_from        = addr_from

        method vias             = List.map sip_via_of_string vias

        method call_id          = call_id

        method cseq             = cseq

        method contact          = sip_contact

        method header name      = Hashtbl.find mime name

        method header_option name = Hashtbl.find_option mime name

        method header_all name  = Hashtbl.find_all mime name

    end
(********************************************************************************************************************
 * Parser for request 
 *
 * I hope it is very fast, but I am not sure if it is safe.
 * TODO: encode an monadic forward-parser and benchmark against this code
 *)

exception Invalid_sip_message

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_response_line buffer =
    let (ver,   last) = find_word 0     buffer in
    let (code,  last) = find_word last  buffer in
    let (msg,   last) = find_endline last  buffer in
    (ver, code, msg, last)

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

    let rec parse_multiline index =
        let (value, index)   = find_endline index buffer in
        if index < String.length buffer && String.get buffer index = ' '
        then
            let (value2, index2) = parse_multiline (succ index) in
            (value ^ value2 , index2)
        else
            (value, index)
        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) = parse_multiline last in
        (*
        print_endline ("KEY " ^ name);
        print_endline ("VAL " ^ value);
        *)
        (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 early_parse_response buffer =
    try
        let (sipver, code, msg, last)      = parse_response_line buffer in
        let (mime, last)                   = parse_mime buffer last in
        (sipver, code, msg, mime, last)
    with
        Not_found | Invalid_argument _ ->
            raise Invalid_sip_message

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

let parse_response buffer =
    let (sipver, code, msg,  mime, last) = early_parse_response buffer in
    try
        new parsed_sip_response code msg sipver mime
    with
        Not_found | Failure _ ->
            raise Invalid_sip_message

type sip_parsed_message
    = Request of sip_request
    | Response of sip_response

let sip_message_from_parsed = function
    | Request  s -> (s : sip_request  :> sip_message)
    | Response s -> (s : sip_response :> sip_message)

let parse_message buffer =
    if String.starts_with buffer "SIP/"
    then Response (parse_response buffer)
    else Request  (parse_request buffer)