Commits

Anonymous committed 517e849

Initial submit of OCaml NAE BEEP Core.

Comments (0)

Files changed (6)

beep/beep_tcp4_endpoint.ml

+(*---------------------------------------------------------------------------*
+  IMPLEMENTATION  beep_tcp4_endpoint.ml
+
+  Copyright (c) 2003-2004, James H. Woodyatt
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions
+  are met:
+
+    Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+
+    Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in
+    the documentation and/or other materials provided with the
+    distribution
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+  OF THE POSSIBILITY OF SUCH DAMAGE. 
+ *---------------------------------------------------------------------------*)
+
+include Beep_tcp_mapping.Create(Cf_tcp4_socket)
+
+(*--- End of File [ beep_tcp4_endpoint.ml ] ---*)

beep/beep_tcp4_endpoint.mli

+(*---------------------------------------------------------------------------*
+  INTERFACE  beep_tcp4_endpoint.mli
+
+  Copyright (c) 2003-2004, James H. Woodyatt
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions
+  are met:
+
+    Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+
+    Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in
+    the documentation and/or other materials provided with the
+    distribution
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+  OF THE POSSIBILITY OF SUCH DAMAGE. 
+ *---------------------------------------------------------------------------*)
+
+include Beep_tcp_mapping.T with module S = Cf_tcp4_socket
+
+(*--- End of File [ beep_tcp4_endpoint.mli ] ---*)

beep/beep_tcp6_endpoint.ml

+(*---------------------------------------------------------------------------*
+  IMPLEMENTATION  beep_tcp6_endpoint.ml
+
+  Copyright (c) 2003-2004, James H. Woodyatt
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions
+  are met:
+
+    Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+
+    Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in
+    the documentation and/or other materials provided with the
+    distribution
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+  OF THE POSSIBILITY OF SUCH DAMAGE. 
+ *---------------------------------------------------------------------------*)
+
+include Beep_tcp_mapping.Create(Cf_tcp6_socket)
+
+(*--- End of File [ beep_tcp6_endpoint.ml ] ---*)

beep/beep_tcp6_endpoint.mli

+(*---------------------------------------------------------------------------*
+  INTERFACE  beep_tcp6_endpoint.mli
+
+  Copyright (c) 2003-2004, James H. Woodyatt
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions
+  are met:
+
+    Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+
+    Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in
+    the documentation and/or other materials provided with the
+    distribution
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+  OF THE POSSIBILITY OF SUCH DAMAGE. 
+ *---------------------------------------------------------------------------*)
+
+include Beep_tcp_mapping.T with module S = Cf_tcp6_socket
+
+(*--- End of File [ beep_tcp6_endpoint.mli ] ---*)

beep/beep_tcp_frame.ml

+(*---------------------------------------------------------------------------*
+  IMPLEMENTATION  beep_tcp_frame.ml
+
+  Copyright (c) 2003-2004, James H. Woodyatt
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions
+  are met:
+
+    Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+
+    Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in
+    the documentation and/or other materials provided with the
+    distribution
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+  OF THE POSSIBILITY OF SUCH DAMAGE. 
+ *---------------------------------------------------------------------------*)
+
+type seq_header_t = {
+    seq_channel: int32;
+    seq_ackno: int32;
+    seq_window: int32;
+}
+
+type seq_t = [ `SEQ of seq_header_t ]
+type t = [ Beep_frame.t | seq_t ]
+
+let k_seq_ = "SEQ"
+
+module Parser = struct
+    open Cf_parser.Op
+    open Cf_lexer.Op
+    
+    type keyword_t = [ Beep_frame.Parser.keyword_t | `K_seq ]
+    
+    class virtual ['c, 'f] core =
+        object(self:'self)
+            inherit ['c, 'f] Beep_frame.Parser.core ()
+            constraint 'f = [> t ]
+            
+            val mutable keyword_: ('c, keyword_t) Cf_lexer.t = Cf_parser.nil
+            
+            method private keyword = keyword_
+            
+            method private frame_seq:
+                'a. check:Beep_frame.Parser.check_fun_t ->
+                    ('c, ([> seq_t ] as 'a)) Cf_lexer.t =
+                fun ~check ->
+                    space_ >>= fun _ ->
+                    self#uint31 >>= fun chan ->
+                    space_ >>= fun _ ->
+                    uint32_ >>= fun ackno ->
+                    space_ >>= fun _ ->
+                    self#uint31 >>= fun window ->
+                    crlf_ >>= fun () ->
+                    check ~chan ~size:0;
+                    let seq = {
+                        seq_channel = chan;
+                        seq_ackno = ackno;
+                        seq_window = window;
+                    } in
+                    ~:(`SEQ seq)
+            
+            method private frame ~check =
+                keyword_ >>= function
+                | `K_msg -> self#frame_msg ~check
+                | `K_rpy -> self#frame_rpy ~check
+                | `K_err -> self#frame_err ~check
+                | `K_ans -> self#frame_ans ~check
+                | `K_nul -> self#frame_nul ~check
+                | `K_seq -> self#frame_seq ~check
+            
+            initializer
+                let seq_rule = !$k_seq_ $= `K_seq in
+                let rule = !@(self#keyword_rule :: [ seq_rule ]) in
+                keyword_ <- Cf_lexer.create rule
+        end
+end
+
+class ['f] parse =
+    object
+        inherit [Beep_frame.Parser.msg_cursor, 'f] Parser.core
+        method private cursor = new Beep_frame.Parser.msg_cursor
+    end
+
+let parse = (new parse :> 'f Beep_frame.Parser.t)
+
+let ufmt_ = "%u"
+let crlf_ = "\r\n"
+
+let emit_seq_ seq b =
+    Buffer.add_string b k_seq_;
+    Buffer.add_char b ' ';
+    Buffer.add_string b (Int32.format ufmt_ seq.seq_channel);
+    Buffer.add_char b ' ';
+    Buffer.add_string b (Int32.format ufmt_ seq.seq_ackno);
+    Buffer.add_char b ' ';
+    Buffer.add_string b (Int32.format ufmt_ seq.seq_window)
+
+let emit = function
+    | `MSG x -> Beep_frame.emit (`MSG x)
+    | `RPY x -> Beep_frame.emit (`RPY x)
+    | `ERR x -> Beep_frame.emit (`ERR x)
+    | `ANS x -> Beep_frame.emit (`ANS x)
+    | `NUL x -> Beep_frame.emit (`NUL x)
+    | `SEQ seq ->
+        let b = Buffer.create 32 in
+        emit_seq_ seq b;
+        Buffer.add_string b crlf_;
+        let s = Buffer.contents b in
+        [ s, 0, String.length s ]
+
+let header_to_string = function
+    | `MSG x -> Beep_frame.header_to_string (`MSG x)
+    | `RPY x -> Beep_frame.header_to_string (`RPY x)
+    | `ERR x -> Beep_frame.header_to_string (`ERR x)
+    | `ANS x -> Beep_frame.header_to_string (`ANS x)
+    | `NUL x -> Beep_frame.header_to_string (`NUL x)
+    | `SEQ seq ->
+        let b = Buffer.create 32 in
+        emit_seq_ seq b;
+        Buffer.contents b    
+
+(*--- End of File [ beep_tcp_frame.ml ] ---*)

beep/beep_tcp_frame.mli

+(*---------------------------------------------------------------------------*
+  INTERFACE  beep_tcp_frame.mli
+
+  Copyright (c) 2003-2004, James H. Woodyatt
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions
+  are met:
+
+    Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+
+    Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in
+    the documentation and/or other materials provided with the
+    distribution
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+  OF THE POSSIBILITY OF SUCH DAMAGE. 
+ *---------------------------------------------------------------------------*)
+
+type seq_header_t = {
+    seq_channel: int32;
+    seq_ackno: int32;
+    seq_window: int32;
+}
+
+type seq_t = [ `SEQ of seq_header_t ]
+type t = [ Beep_frame.t | seq_t ]
+
+module Parser: sig
+    type keyword_t = [ Beep_frame.Parser.keyword_t | `K_seq ]
+    
+    class virtual ['c, 'f] core:
+        object
+            inherit ['c, 'f] Beep_frame.Parser.core
+            constraint 'f = [> t ]
+            
+            method private keyword: ('c, keyword_t) Cf_lexer.t
+            
+            method private frame_seq:
+                'a. check:Beep_frame.Parser.check_fun_t ->
+                ('c, ([> seq_t ] as 'a)) Cf_lexer.t
+
+            method private frame:
+                check:Beep_frame.Parser.check_fun_t -> ('c, 'f) Cf_lexer.t
+        end
+end
+
+val parse: [> t ] Beep_frame.Parser.t
+val emit: [< t ] -> Cf_message.t
+val header_to_string: [< t ] -> string
+
+(*--- End of File [ beep_tcp_frame.mli ] ---*)