package gapi-ocaml

You can search for identifiers within the package.

in-package search v0.2.0

A simple OCaml client for Google Services

Install

dune-project

Dependency

github.com Readme Edit opam file Versions (2)

Authors

A

Alessandro Strada

Maintainers

A

Alessandro Strada <alessandro.strada@gmail.com>

Sources

v0.4.7.tar.gz

sha256=3a9e7ba4446b90f842c10dc2e49211c394c9f012715da01bb0b80baccabb41bb

md5=27919a0188772392e9b74bfd95fbaaa1

doc/src/gapi-ocaml.netstring-local/netascii_armor.ml.html

Source file `netascii_armor.ml`

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
(* $Id$ *)

type armor_type = [ `Plain | `Base64 | `OpenPGP ]

type armored_message =
    [ `Plain of Netmime.mime_body
    | `Base64 of Netmime.mime_body
    | `OpenPGP of Netmime.mime_header * Netmime.mime_body * int
    ]

type armored_message_ro =
    [ `Plain of Netmime.mime_body_ro
    | `Base64 of Netmime.mime_body_ro
    | `OpenPGP of Netmime.mime_header_ro * Netmime.mime_body_ro * int
    ]

type armor_spec = (string * armor_type) list 

let begin_re =
  Netstring_str.regexp "^-----BEGIN \\(.*\\)-----[ \t\r]*$"

let end_re =
  Netstring_str.regexp "^-----END \\(.*\\)-----[ \t\r]*$"

let cksum_re =
  Netstring_str.regexp "^=\\([A-Za-z0-9+/=]+\\)[ \t\r]*$"


let parse spec (ch : Netchannels.in_obj_channel) =
  let rec next_begin_boundary() =
    let line_opt = try Some(ch # input_line()) with End_of_file -> None in
    match line_opt with
      | None -> []
      | Some line ->
           if line <> "" && line.[0] = '-' then
             match Netstring_str.string_match begin_re line 0 with
               | None -> next_begin_boundary()
               | Some m ->
                    let tag = Netstring_str.matched_group m 1 line in
                    let armor_type_opt = 
                      try Some(List.assoc tag spec) with Not_found -> None in
                    ( match armor_type_opt with
                        | None -> next_begin_boundary()
                        | Some armor_type ->
                             read_message tag armor_type
                    )
           else
             next_begin_boundary()

    and read_message tag armor_type =
      let body = new Netmime.memory_mime_body "" in
      let body_ch = body # open_value_wr() in
      match armor_type with
        | `Plain ->
             let followup code =
               body_ch # close_out();
               match code with
                 | `Error -> []
                 | `End -> 
                      let body_ro = (body :> Netmime.mime_body_ro) in
                      (tag, `Plain body_ro) :: next_begin_boundary()
                 | `End_cksum _ -> assert false in
             parse_message_body 
               ~enable_checksum:false 
               ~followup
               tag armor_type body_ch
        | `Base64 ->
             let filter = 
               new Netencoding.Base64.decoding_pipe ~accept_spaces:true () in
             let base64_ch =
               new Netchannels.output_filter filter body_ch in
             let followup code =
               base64_ch # close_out();
               body_ch # close_out();
               match code with
                 | `Error -> []
                 | `End -> 
                      let body_ro = (body :> Netmime.mime_body_ro) in
                      (tag, `Base64 body_ro) :: next_begin_boundary()
                 | `End_cksum _ -> assert false in
             parse_message_body 
               ~enable_checksum:false 
               ~followup
               tag armor_type base64_ch
        | `OpenPGP ->
             assert false (* TODO *)

    and is_expected_end_boundary line tag =
      match Netstring_str.string_match end_re line 0 with
        | None ->
             false
        | Some m ->
             let real_tag = Netstring_str.matched_group m 1 line in
             real_tag = tag

    and parse_message_body ~enable_checksum ~followup
                           tag armor_type out_ch =
      let rec parse() =
        let line_opt = try Some(ch # input_line()) with End_of_file -> None in
        match line_opt with
          | None ->
               followup `Error
          | Some line ->
               let checksum_opt =
                 if enable_checksum && line <> "" && line.[0] = '=' then
                   match Netstring_str.string_match cksum_re line 0 with
                     | Some m ->
                          let sum = Netstring_str.matched_group m 1 line in
                          if String.length sum = 4 then
                            try
                              Some(Netencoding.Base64.decode sum)
                            with _ -> None
                          else
                            None
                     | None ->
                          None
                 else
                   None in
               match checksum_opt with
                 | None ->
                      if is_expected_end_boundary line tag then
                        followup `End
                      else (
                        out_ch # output_string line;
                        out_ch # output_string "\n";
                        parse()
                      )
                 | Some checksum ->
                      assert(String.length checksum = 3);
                      let v =
                        ((Char.code checksum.[0]) lsl 16) lor
                          ((Char.code checksum.[1]) lsl 8) lor
                            (Char.code checksum.[2]) in
                      let line_opt = 
                        try Some(ch # input_line()) with End_of_file -> None in
                      ( match line_opt with
                          | None ->
                               followup `Error
                          | Some line ->
                               if is_expected_end_boundary line tag then
                                 followup (`End_cksum v)
                               else
                                 followup `Error
                      )
      in
      parse()
  in
  next_begin_boundary()