File: dbMessages.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 (226 lines) | stat: -rw-r--r-- 8,578 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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
(***********************************************************************)
(* dbMessages.ml- Message types for communicating with com ports on    *)
(*                dbserver and reconserver                             *)
(* 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 MoreLabels
open StdLabels
open Packet
open CMarshal
open Common
open Printf
module Unix=UnixLabels
module Set = PSet.Set


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

type configvar = [ `int of int | `float of float | `string of string | `none ]

let marshal_config cout (s,cvar) =
  marshal_string cout s;
  match cvar with
    | `int x -> cout#write_byte 0; cout#write_int x
    | `float x -> cout#write_byte 1; cout#write_float x
    | `string x -> cout#write_byte 2; marshal_string cout x
    | `none -> cout #write_byte 3

let unmarshal_config cin =
  let s = unmarshal_string cin in
  let cvar =
    match cin#read_byte with
      | 0 -> `int cin#read_int
      | 1 -> `float cin#read_float
      | 2 -> `string (unmarshal_string cin)
      | 3 -> `none
      | _ -> failwith "Type failure unmarshalling config variable"
  in
  (s,cvar)

(***********************************)
(* Data Types  ********************)
(***********************************)

type msg = | WordQuery of string list
           | LogQuery of (int * timestamp) (* must make other changes.... *)
           | HashRequest of string list
           | LogResp of ( timestamp * event) list
           | Keys of key list
           | KeyStrings of string list
           | Ack of int
           | MissingKeys of (string list * Unix.sockaddr) (* DEPRECATED *)
           | Synchronize
           | RandomDrop of int
           | ProtocolError
           | DeleteKey of string
           | Config of (string * configvar)
           | Filters of string list

(****  data specific marshallers  ****)

let marshal_timestamp cout timestamp = cout#write_float timestamp
let unmarshal_timestamp cin = cin#read_float

let marshal_logquery cout logquery =
  let (count,timestamp) = logquery in
  cout#write_int count;
  marshal_timestamp cout timestamp

let unmarshal_logquery cin =
  let count = cin#read_int in
  let timestamp = unmarshal_timestamp cin in
  (count,timestamp)

let marshal_event cout event =  match event with
  | Add hash -> cout#write_byte 0; marshal_string cout hash
  | Delete hash -> cout#write_byte 1; marshal_string cout hash

let unmarshal_event cin =
  match cin#read_byte with
      0 -> Add (unmarshal_string cin)
    | 1 -> Delete (unmarshal_string cin)
    | _ -> failwith "Unexpected code for event"

let marshal_log_entry cout ( timestamp , event ) =
  marshal_timestamp cout timestamp;
  marshal_event cout event

let unmarshal_log_entry cin =
  let timestamp = unmarshal_timestamp cin in
  let event = unmarshal_event cin in
  (timestamp,event)

let marshal_key cout key = marshal_string cout (Key.to_string key)
let unmarshal_key cin = Key.of_string (unmarshal_string cin)

let marshal_key_list l = marshal_list ~f:marshal_key l
let unmarshal_key_list l = unmarshal_list ~f:unmarshal_key l

let marshal_missingkeys cout (list,sockaddr) =
  marshal_list ~f:marshal_string cout list;
  marshal_sockaddr cout sockaddr

let unmarshal_missingkeys cin =
  let list = unmarshal_list ~f:unmarshal_string cin in
  let sockaddr = unmarshal_sockaddr cin in
  (list,sockaddr)

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

let marshal_msg cout msg =
  match msg with
     | WordQuery x -> cout#write_byte 0; marshal_list ~f:marshal_string cout x
     | LogQuery x -> cout#write_byte 1; marshal_logquery cout x
     | LogResp x -> cout#write_byte 2; marshal_list ~f:marshal_log_entry cout x
     | Keys x -> cout#write_byte 3; marshal_list ~f:marshal_key cout x
         (* keystrings is just an alias for keys. They're sent over the wire
            in the same form *)
     | KeyStrings x -> cout#write_byte 3; marshal_list ~f:marshal_string cout x
     | Ack x -> cout#write_byte 4; cout#write_int x
     | MissingKeys x -> failwith "DO NOT USE MissingKeys"
         (* cout#write_byte 5; marshal_missingkeys cout x*)
     | Synchronize -> cout#write_byte 6
     | RandomDrop x -> cout#write_byte 7; cout#write_int x
     | ProtocolError -> cout#write_byte 8
     | DeleteKey s -> cout#write_byte 9; marshal_string cout s
     | HashRequest x -> cout#write_byte 10; marshal_list ~f:marshal_string cout x
     | Config x ->            cout#write_byte 11; marshal_config cout x
     | Filters x -> cout#write_byte 12; marshal_list ~f:marshal_string cout x


let rec unmarshal_msg cin =
  let rval =
  match cin#read_byte with
    | 0 -> WordQuery (unmarshal_list ~f:unmarshal_string cin)
    | 1 -> LogQuery (unmarshal_logquery cin)
    | 2 ->
        LogResp (unmarshal_list ~f:unmarshal_log_entry cin)
    | 3 -> Keys (unmarshal_list ~f:unmarshal_key cin)
    | 4 -> Ack cin#read_int
    | 5 -> MissingKeys (unmarshal_missingkeys cin)
    | 6 -> Synchronize
    | 7 -> RandomDrop cin#read_int
    | 8 -> ProtocolError
    | 9 -> DeleteKey (unmarshal_string cin)
    | 10 -> HashRequest (unmarshal_list ~f:unmarshal_string cin)
    | 11 -> Config (unmarshal_config cin)
    | 12 -> Filters (unmarshal_list ~f:unmarshal_string cin)
    | _ -> failwith "Unexpected message type"
  in
  rval

let sockaddr_to_string sockaddr = match sockaddr with
    Unix.ADDR_UNIX s -> sprintf "<ADDR_UNIX %s>" s
  | Unix.ADDR_INET (addr,p) -> sprintf "<ADDR_INET [%s]:%d>" (Unix.string_of_inet_addr addr) p

let msg_to_string msg =
  match msg with
      WordQuery words -> "WordQuery: " ^ (String.concat ", " words)
    | LogQuery (count,timestamp) -> sprintf "LogQuery: (%d,%f)" count timestamp
    | LogResp list ->
        let length = List.length list in
        sprintf "LogResp: %d events" length
    | Keys keys ->
        let length = List.length keys in
        sprintf "Keys: %d keys" length
    | KeyStrings keystrings ->
        let length = List.length keystrings in
        sprintf "KeyStrings: %d keystrings" length
    | Ack i ->
        sprintf "Ack: %d" i
    | MissingKeys (keys,sockaddr) ->
        if List.length keys > 20 then
          sprintf "MissingKeys: %d keys from %s"
            (List.length keys) (sockaddr_to_string sockaddr)
        else
          sprintf "MissingKeys from %s: [ %s ]"
            (sockaddr_to_string sockaddr)
            (String.concat ~sep:""
               (List.map ~f:(sprintf "\n\t%s")
                  (List.map Utils.hexstring keys)))
    | Synchronize -> sprintf "Synchronize"
    | RandomDrop i ->
        sprintf "RandomDrop: %d" i
    | ProtocolError -> "ProtocolError"
    | DeleteKey x -> sprintf "DeleteKey %s" (Utils.hexstring x)
    | HashRequest x -> sprintf "HashRequest(%d)" (List.length x)
    | Config (s,cvar) -> sprintf "Config(s," ^
         (match cvar with
              `int x -> sprintf "%d)" x
            | `float x -> sprintf "%f)" x
            | `string x -> sprintf "%s)" x
            | `none -> "none)"
         )
    | Filters filters -> sprintf "Filters(%s)"
        (String.concat ~sep:"," filters)


module M =
  MsgContainer.Container(
    struct
      type msg_t = msg
      let marshal = marshal_msg
      let unmarshal = unmarshal_msg
      let to_string = msg_to_string
      let print = (fun s -> plerror 7 "%s" s)
    end
  )

include M