File: cMarshal.ml

package info (click to toggle)
sks 1.1.6-14
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 2,296 kB
  • sloc: ml: 15,228; ansic: 1,069; sh: 358; makefile: 347
file content (137 lines) | stat: -rw-r--r-- 4,516 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
(***********************************************************************)
(* cMarshal.ml - Marshaling into and out of channels                   *)
(*               (see [Channel] module)                                *)
(*                                                                     *)
(* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *)
(*               2011, 2012, 2013  Yaron Minsky and Contributors       *)
(*                                                                     *)
(* This file is part of SKS.  SKS is free software; you can            *)
(* redistribute it and/or modify it under the terms of the GNU General *)
(* Public License as published by the Free Software Foundation; either *)
(* version 2 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   *)
(* General Public License for more details.                            *)
(*                                                                     *)
(* You should have received a copy of the GNU General Public License   *)
(* along with this program; if not, write to the Free Software         *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
(* USA or see <http://www.gnu.org/licenses/>.                          *)
(***********************************************************************)

open StdLabels
open MoreLabels
module ZSet = ZZp.Set

let marshal_string cout string =
  ignore (cout:>Channel.out_channel_obj);
  cout#write_int (String.length string);
  cout#write_string string

let unmarshal_string cin =
  let length = cin#read_int in
    cin#read_string length

(*****)

let marshal_lstring cout string =
  cout#write_string string

let unmarshal_lstring length cin =
  cin#read_string length


(*****)

let rec marshal_array ~f cout array =
  cout#write_int (Array.length array);
  Array.iter ~f:(f cout) array

let rec unmarshal_array ~f cin =
  let len = cin#read_int in
  Array.init len ~f:(fun i -> f cin)

(*****)

let rec marshal_list ~f cout list =
  cout#write_int (List.length list);
  List.iter ~f:(f cout) list

let rec unmarshal_list ~f cin =
  Array.to_list (unmarshal_array ~f cin)

(*****)

let marshal_fixed_sarray cout sarray =
  let len = try String.length sarray.(0) with _ -> 0 in
  Array.iter ~f:(fun s ->
                   if String.length s <> len
                   then failwith ("Strings not same length in " ^
                                  "marshal_fixed_sarray")) sarray;
  cout#write_int len;
  marshal_array ~f:marshal_lstring cout sarray

let unmarshal_fixed_sarray cin sarray =
  let len = cin#read_int in
  unmarshal_array ~f:(unmarshal_lstring len) cin

(*****)


let marshal_bitstring cout bs =
  cout#write_int (Bitstring.num_bits bs);
  marshal_string cout (Bitstring.to_bytes_nocopy bs)

let unmarshal_bitstring cin =
  let bitlength = cin#read_int
  and string = unmarshal_string cin in
  Bitstring.of_bytes_nocopy string bitlength

(*****)

let marshal_set ~f cout set =
  let array = Array.of_list (ZSet.elements set) in
  marshal_array ~f cout array


let unmarshal_set ~f cin =
  let array = unmarshal_array ~f cin in
  ZZp.zset_of_list (Array.to_list array)

(*************************************************************)

let marshal_sockaddr cout sockaddr =
  match sockaddr with
    | Unix.ADDR_UNIX s ->
        cout#write_byte 0; marshal_string cout s
    | Unix.ADDR_INET (s,i) ->
        cout#write_byte 1;
        marshal_string cout (Unix.string_of_inet_addr s);
        cout#write_int i

let unmarshal_sockaddr cin =
  match cin#read_byte with
      0 -> Unix.ADDR_UNIX (unmarshal_string cin)
    | 1 ->
        let s = unmarshal_string cin in
        let i = cin#read_int in
        Unix.ADDR_INET (Unix.inet_addr_of_string s,i)
    | _ -> failwith "Unmarshalling failed: malformed sockaddr"

(************************************************************)

let marshal_to_string ~f x =
  let cout = Channel.new_buffer_outc 0 in
  f cout x;
  cout#contents

let unmarshal_from_string ~f s =
  let cin = new Channel.string_in_channel s 0 in
  f cin


let int_to_string x = marshal_to_string ~f:(fun cout x -> cout#write_int x) x
let int_of_string s = unmarshal_from_string ~f:(fun cin -> cin#read_int) s