Source file `secret.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
type kind =
  | Singleline
  | Multiline

type t = {
  kind : kind;
  text : string;
  comments : string option;
}

let kind_to_string k =
  match k with
  | Singleline -> "single-line"
  | Multiline -> "multi-line"

let singleline_from_text_description text description =
  match description with
  | "" -> text
  | _ -> Printf.sprintf "%s\n\n%s" text description

let multiline_from_text_description text description =
  match description with
  | "" -> Printf.sprintf "\n\n%s" text
  | _ -> Printf.sprintf "\n%s\n\n%s" description text

module Validation = struct
  type validation_error =
    | SingleLineLegacy
    | MultilineEmptySecret
    | EmptySecret
    | InvalidFormat

  let validate plaintext =
    if String.trim plaintext = "" then Error ("empty secrets are not allowed", EmptySecret)
    else (
      (* We can only use String.trim on the individual lines as we'd be stripping
         out leading empty lines, thus missing multi-line secrets due to the format spec.

         We need to use String.trim below on each line read to make sure that we don't have
         spaces or other whitespace characters in lines that might lead to false negatives *)
      let lines = String.split_on_char '\n' plaintext in
      match lines with
      (* multi-line with comments *)
      | "" :: comment :: rest when String.trim comment <> "" ->
        (* find the empty line that introduces the secret and make sure that it has content *)
        let secret, _is_secret =
          List.fold_left
            (fun (secret, is_secret) line ->
              match is_secret, String.trim line with
              | true, s when s <> "" -> line :: secret, true
              | true, _ -> secret, true
              | false, "" -> secret, true
              | false, _ -> secret, false)
            ([], false) rest
        in
        if secret = [] then Error ("multiline: empty secret", MultilineEmptySecret) else Ok Multiline
      (* multi-line without comments *)
      | "" :: "" :: secret :: _ when String.trim secret <> "" -> Ok Multiline
      (* single-line with comments *)
      | secret :: "" :: _ when String.trim secret <> "" -> Ok Singleline
      (* We don't want to allow the creation of new secrets in legacy single-line format *)
      | secret :: comment :: _ when String.trim secret <> "" && String.trim comment <> "" ->
        Error ("legacy single line secret format. Please use the correct format", SingleLineLegacy)
      (* single-line without comments *)
      | [ secret ] when String.trim secret <> "" -> Ok Singleline
      | _ -> Error ("invalid format", InvalidFormat))

  (**
 Multiline secret with comments format:
     <empty line>
     possibly several lines of comments without empty lines
     <empty line>
     secret until end of file

 Multiline secret without comments format:
     <empty line>
     <empty line>
     secret until end of file

 Single line secret with commments format:
     secret one line
     <empty line>
     comments until end of file

 Single line secret without commments format:
     secret one line

 Single line secret with commments legacy format [DEPRECATED]:
     secret one line
     comments until the end of file
 *)
  let parse_exn plaintext_content =
    if String.trim plaintext_content = "" then failwith "empty secrets are not allowed";
    let lines = String.split_on_char '\n' plaintext_content in
    let to_comments_format comments =
      match comments with
      | [] -> None
      | _ -> Some (comments |> String.concat "\n" |> String.trim)
    in
    match lines with
    | "" :: tl ->
      (* multi-line secret *)
      let text, comments_lines, (_ : bool) =
        List.fold_left
          (fun (secret_text, comments, is_secret) line ->
            match is_secret, line with
            | true, _ -> line :: secret_text, comments, true
            | false, "" -> secret_text, comments, true
            | false, s -> secret_text, s :: comments, false)
          ([], [], false) tl
      in
      let text = List.rev text |> String.concat "\n" |> String.trim in
      if text = "" then failwith "broken format multi-line secret (empty secret text). Please fix secret."
      else { kind = Multiline; text; comments = to_comments_format (List.rev comments_lines) }
      (* We keep the second pattern to match legacy secrets,
         which didn't have an empty line to separate from comments *)
    | text :: "" :: comments_lines | text :: comments_lines ->
      (* single line secret *)
      { kind = Singleline; text; comments = to_comments_format comments_lines }
    | [] -> failwith "empty secrets are not allowed"

  let validity_to_string name secret_text =
    match validate secret_text with
    | Ok kind -> Printf.sprintf "✅ %s [ valid %s ]" name (kind_to_string kind)
    | Error (e, _typ) -> Printf.sprintf "❌ %s Invalid format: %s" name e
end