File: request.ml

package info (click to toggle)
sks 1.1.6-4~bpo%2B1
  • links: PTS, VCS
  • area: main
  • in suites: jessie-backports
  • size: 2,032 kB
  • sloc: ml: 15,224; ansic: 1,069; makefile: 344; sh: 303
file content (99 lines) | stat: -rw-r--r-- 4,474 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
(***********************************************************************)
(* request.ml                                                          *)
(*                                                                     *)
(* 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
open Printf
open Common

let amp = Str.regexp "&"

let chsplit c s =
  let eqpos = String.index s c in
  let first = Str.string_before s eqpos
  and second = Str.string_after s (eqpos + 1) in
  (first, second)

let eqsplit s = chsplit '=' s

type request_kind = VIndex | Index | Get | HGet | Stats

type request = { kind: request_kind;
                 search: string list;
                 fingerprint: bool;
                 hash: bool;
                 exact: bool;
                 machine_readable: bool;
                 clean: bool;
                 limit: int;
               }

let default_request = { kind = Index;
                        search = [];
                        fingerprint = false;
                        hash = false;
                        exact = false;
                        machine_readable = false;
                        clean = true;
                        limit = (-1);
                      }

let comma_rxp = Str.regexp ","

let rec request_of_oplist ?(request=default_request) oplist =
  match oplist with
      [] -> request
    | hd::tl ->
        let new_request =
          match hd with
            | ("options",options) ->
                let options = Str.split comma_rxp options in
                if List.mem "mr" options
                then { request with machine_readable = true }
                else request
            | ("op","stats") -> {request with kind = Stats };
            | ("op","x-stats") -> {request with kind = Stats };
            | ("op","index") -> {request with kind = Index };
            | ("op","vindex") -> {request with kind = VIndex };
            | ("op","get") -> {request with kind = Get};
            | ("op","hget") -> {request with kind = HGet};
            | ("op","x-hget") -> {request with kind = HGet};
            | ("limit",c) -> {request with limit = (int_of_string c)};
            | ("search",s) ->
                {request with search =
                   List.rev (Utils.extract_words (String.lowercase s))
                };
            | ("fingerprint","on") ->  {request with fingerprint = true};
            | ("fingerprint","off") ->  {request with fingerprint = false};
            | ("hash","on") ->  {request with hash = true};
            | ("hash","off") ->  {request with hash = false};
            | ("x-hash","on") ->  {request with hash = true};
            | ("x-hash","off") ->  {request with hash = false};
            | ("exact","on") ->  {request with exact = true};
            | ("exact","off") ->  {request with exact = false};
            | ("clean","on") -> {request with clean = true;}
            | ("clean","off") -> {request with clean = false;}
            | ("x-clean","on") -> {request with clean = true;}
            | ("x-clean","off") -> {request with clean = false;}
            | _ -> request
        in
        request_of_oplist tl ~request:new_request