package dune-release

  1. Overview
  2. Docs

Source file distrib.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
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
(*---------------------------------------------------------------------------
   Copyright (c) 2016 Daniel C. Bünzli. All rights reserved.
   Distributed under the ISC license, see terms at the end of the file.
   dune-release 0.2.0
  ---------------------------------------------------------------------------*)

open Rresult
open Astring

(* Watermarks *)

type watermark =
  string *
  [ `String of string
  | `Name
  | `Version
  | `Version_num
  | `Vcs of [ `Commit_id ]
  | `Opam of Fpath.t option * string * string ]

let opam_fields ~dry_run file =
  (Opam.File.fields ~dry_run file)
  |> R.reword_error_msg ~replace:true (fun msg -> R.msgf "Watermarks: %s" msg)
  |> Logs.on_error_msg ~level:Logs.Warning ~use:(fun () -> String.Map.empty)

let opam_field =
  let opam_memo = ref Fpath.Map.empty in (* memoizes the opam files *)
  let rec opam_field ~dry_run file field = match Fpath.Map.find file !opam_memo with
  | None ->
      opam_memo := Fpath.Map.add file (opam_fields ~dry_run file) !opam_memo;
      opam_field ~dry_run file field
  | Some fields ->
      match String.Map.find field fields with
      | Some vs -> vs
      | None ->
          if not dry_run then
            Logs.warn
              (fun m -> m "file %a: opam field %S undefined or unsupported"
                  Fpath.pp file field);
          ["UNDEFINED"]
  in
  opam_field

let vcs_commit_id () =
  (Vcs.get () >>= fun repo -> Vcs.head ~dirty:true repo)
  |> R.reword_error_msg ~replace:true
    (fun msg -> R.msgf "Watermarks: VCS commit id determination: %s" msg)
  |> Logs.on_error_msg ~level:Logs.Warning ~use:(fun () -> "UNDEFINED")

let drop_initial_v version = match String.head version with
| Some ('v' | 'V') -> String.with_index_range ~first:1 version
| None | Some _ -> version

let define_watermarks ~dry_run ~name ~version ~opam watermarks =
  let define (id, v) =
    let (id, v as def) = match v with
    | `String s -> (id, s)
    | `Version -> (id, version)
    | `Version_num -> (id, drop_initial_v version)
    | `Name -> (id, name)
    | `Vcs `Commit_id -> (id, vcs_commit_id ())
    | `Opam (file, field, sep) ->
        let file = match file with None -> opam | Some file -> file in
        (id, String.concat ~sep (opam_field ~dry_run file field))
    in
    Logs.info (fun m -> m "Watermark %s = %S" id v);
    def
  in
  List.map define watermarks

let with_parent_check op op_name file =
  let err_no_parent op_name file =
    Fmt.strf "%a: Cannot %s file, parent directory does not exist"
      Fpath.pp file op_name
  in
  (Bos.OS.Dir.must_exist (Fpath.parent file)
   >>= fun _ -> Ok (op (Fpath.to_string file)))
  |> R.reword_error @@ fun _ -> `Msg (err_no_parent op_name file)

let safe_open_out_bin = with_parent_check open_out_bin "write"

let write_subst file vars s = (* very ugly mister, too lazy to rewrite *)
  try
    let close oc = if file = Bos.OS.File.dash then () else close_out_noerr oc in
    (if file = Bos.OS.File.dash then Ok stdout
     else safe_open_out_bin file) >>= fun oc ->
    try
      let start = ref 0 in
      let last = ref 0 in
      let len = String.length s in
      while (!last < len - 4) do
        if not (s.[!last] = '%' && s.[!last + 1] = '%') then incr last else
        begin
          let start_subst = !last in
          let last_id = ref (!last + 2) in
          let stop = ref false in
          while (!last_id < len - 1 && not !stop) do
            if not (s.[!last_id] = '%' && s.[!last_id + 1] = '%') then begin
              if s.[!last_id] <> ' ' then (incr last_id) else
              (stop := true; last := !last_id)
            end else begin
              let id_start = start_subst + 2 in
              let id =
                String.with_range s ~first:(id_start) ~len:(!last_id - id_start)
              in
              try
                let subst = List.assoc id vars in
                output oc (Bytes.unsafe_of_string s)
                  !start (start_subst - !start);
                output_string oc subst;
                stop := true;
                start := !last_id + 2;
                last := !last_id + 2;
              with Not_found ->
                stop := true;
                last := !last_id
            end
          done;
          (* we exited the loop because we reached eof *)
          if not !stop then last := !last_id
        end
      done;
      output oc (Bytes.unsafe_of_string s) !start (len - !start);
      flush oc;
      close oc;
      Ok ()
    with exn -> close oc; raise exn
  with Sys_error e -> R.error_msgf "%a: %s" Fpath.pp file e

let watermark_file ws file =
  Bos.OS.File.read file >>= fun content ->
  write_subst file ws content >>= fun () ->
  Logs.info (fun m -> m "Watermarked %a" Fpath.pp file); Ok ()

let rec watermark_files ws = function
| [] -> Ok ()
| f :: fs -> watermark_file ws f >>= fun () -> watermark_files ws fs

(* Defaults *)

let default_watermarks =
  let space = " " in
  let comma = ", " in
  [ "NAME", `Name;
    "VERSION", `Version;
    "VERSION_NUM", `Version_num;
    "VCS_COMMIT_ID", `Vcs `Commit_id;
    "PKG_MAINTAINER", `Opam (None, "maintainer", comma);
    "PKG_AUTHORS", `Opam (None, "authors", comma);
    "PKG_HOMEPAGE", `Opam (None, "homepage", comma);
    "PKG_ISSUES", `Opam (None, "bug-reports", space);
    "PKG_DOC", `Opam (None, "doc", space);
    "PKG_LICENSE", `Opam (None, "license", comma);
    "PKG_REPO", `Opam (None, "dev-repo", space); ]

let default_files_to_watermark =
  let is_file f =
    Bos.OS.File.exists f |> Logs.on_error_msg ~use:(fun _ -> false)
  in
  let is_binary_ext ext =
    let module Set = Set.Make (String) in
    let exts =
      Set.(empty |>
           add ".flv" |> add ".gif" |> add ".ico" |> add ".jpeg" |>
           add ".jpg" |> add ".mov" |> add ".mp3" |> add ".mp4" |>
           add ".otf" |> add ".pdf" |> add ".png" |> add ".ttf" |>
           add ".woff")
    in
    Set.mem ext exts
  in
  let keep f = not (is_binary_ext @@ Fpath.get_ext f) && is_file f in
  fun () ->
    Vcs.get ()
    >>= fun repo -> Vcs.tracked_files repo
    >>= fun files -> Ok (List.filter keep files)

let default_massage () = Ok ()

let default_exclude_paths () =
  let l =
    List.map Fpath.v [
      ".git"; ".gitignore"; ".gitattributes"; ".hg"; ".hgignore"; "build";
      "Makefile"; "_build"
    ] in
  Ok l

(* Distribution *)

type t =
  { watermarks : watermark list;
    files_to_watermark : unit -> (Fpath.t list, R.msg) result;
    massage : unit -> (unit, R.msg) result;
    exclude_paths : unit -> (Fpath.t list, R.msg) result; }

let v
    ?(watermarks = default_watermarks)
    ?(files_to_watermark = default_files_to_watermark)
    ?(massage = fun () -> Ok ())
    ?(exclude_paths = default_exclude_paths) () =
  { watermarks; files_to_watermark; massage; exclude_paths }

let watermarks d = d.watermarks
let files_to_watermark d = d.files_to_watermark
let massage d = d.massage
let exclude_paths d = d.exclude_paths

(*---------------------------------------------------------------------------
   Copyright (c) 2016 Daniel C. Bünzli

   Permission to use, copy, modify, and/or distribute this software for any
   purpose with or without fee is hereby granted, provided that the above
   copyright notice and this permission notice appear in all copies.

   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  ---------------------------------------------------------------------------*)
OCaml

Innovation. Community. Security.