package opam-state

  1. Overview
  2. Docs

Source file opamUpdate.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
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
(**************************************************************************)
(*                                                                        *)
(*    Copyright 2012-2019 OCamlPro                                        *)
(*    Copyright 2012 INRIA                                                *)
(*                                                                        *)
(*  All rights reserved. This file is distributed under the terms of the  *)
(*  GNU Lesser General Public License version 2.1, with the special       *)
(*  exception on linking described in the file LICENSE.                   *)
(*                                                                        *)
(**************************************************************************)

open OpamTypes
open OpamStateTypes
open OpamStd.Op
open OpamProcess.Job.Op
open OpamFilename.Op

let log fmt = OpamConsole.log "UPDATE" fmt
let slog = OpamConsole.slog

let eval_redirect gt repo repo_root =
  if repo.repo_url.OpamUrl.backend <> `http then None else
  let redirect =
    OpamRepositoryPath.repo repo_root
    |> OpamFile.Repo.safe_read
    |> OpamFile.Repo.redirect
  in
  let redirect = List.fold_left (fun acc (redirect, filter) ->
      if OpamFilter.opt_eval_to_bool (OpamPackageVar.resolve_global gt) filter
      then (redirect, filter) :: acc
      else acc
    ) [] redirect in
  match redirect with
  | []         -> None
  | (redirect, f) :: _ ->
    let redirect_url =
      if OpamStd.String.contains ~sub:"://" redirect
      then
        let red = OpamUrl.parse_opt ~handle_suffix:false redirect in
        if red = None then
          OpamConsole.error "Ignoring malformed redirection url %s" redirect;
        red
      else Some OpamUrl.Op.(repo.repo_url / redirect)
    in
    match redirect_url with
    | Some ru when ru = repo.repo_url -> None
    | Some ru -> Some (ru, f)
    | None -> None

let repository rt repo =
  let max_loop = 10 in
  let gt = rt.repos_global in
  if repo.repo_url = OpamUrl.empty then Done None else
  let repo_root = OpamRepositoryState.get_repo_root rt repo in
  (* Recursively traverse redirection links, but stop after 10 steps or if
     we cycle back to the initial repo. *)
  let rec job r redirect n =
    if n = 0 then
      (OpamConsole.warning "%s: Too many redirections, stopping."
         (OpamRepositoryName.to_string repo.repo_name);
       Done (r, `No_changes))
    else
    let text =
      OpamProcess.make_command_text ~color:`blue
        (OpamRepositoryName.to_string repo.repo_name)
        OpamUrl.(string_of_backend repo.repo_url.backend)
    in
    OpamProcess.Job.with_text text @@
    OpamRepository.update r repo_root @@+ fun has_changes ->
    let has_changes = if redirect then `Changes else has_changes in
    if n <> max_loop && r = repo then
      (OpamConsole.warning "%s: Cyclic redirections, stopping."
         (OpamRepositoryName.to_string repo.repo_name);
       Done (r, has_changes))
    else match eval_redirect gt r repo_root with
      | None -> Done (r, has_changes)
      | Some (new_url, f) ->
        OpamFilename.cleandir repo_root;
        let reason = match f with
          | None   -> ""
          | Some f -> Printf.sprintf " (%s)" (OpamFilter.to_string f) in
        OpamConsole.note
          "The repository '%s' will be *%s* redirected to %s%s"
          (OpamRepositoryName.to_string repo.repo_name)
          (OpamConsole.colorise `bold "permanently")
          (OpamUrl.to_string new_url)
          reason;
        job { r with repo_url = new_url } true (n-1)
  in
  job repo false max_loop @@+ fun (repo, has_changes) ->
  let repo_file_path = OpamRepositoryPath.repo repo_root in
  if not (OpamFile.exists repo_file_path) then
    OpamConsole.warning
      "The repository '%s' at %s doesn't have a 'repo' file, and might not be \
       compatible with this version of opam."
      (OpamRepositoryName.to_string repo.repo_name)
      (OpamUrl.to_string repo.repo_url);
  match has_changes with
  | `No_changes ->
    log "Repository did not change: nothing to do.";
    Done None
  | `Changes ->
    log "Repository has new changes";
    let repo_file = OpamFile.Repo.safe_read repo_file_path in
    let repo_file = OpamFile.Repo.with_root_url repo.repo_url repo_file in
    let repo_vers =
      OpamStd.Option.default OpamFile.Repo.format_version @@
      OpamFile.Repo.opam_version repo_file
    in
    if not OpamFormatConfig.(!r.skip_version_checks) &&
       OpamVersion.compare repo_vers OpamVersion.current > 0 then
      Printf.ksprintf failwith
        "repository format version is %s, and this is only opam %s"
        (OpamVersion.to_string repo_vers)
        (OpamVersion.to_string OpamVersion.current);
    List.iter (fun (msg, filter) ->
        if OpamFilter.opt_eval_to_bool (OpamPackageVar.resolve_global gt) filter
        then
          OpamConsole.formatted_msg ~indent:4 "%s (at %s): %s\n"
            (OpamConsole.colorise' [`bold;`green]
               (OpamRepositoryName.to_string repo.repo_name))
            (OpamConsole.colorise `bold (OpamUrl.to_string repo.repo_url))
            msg)
      (OpamFile.Repo.announce repo_file);
    let tarred_repo = OpamRepositoryPath.tar gt.root repo.repo_name in
    (if OpamRepositoryConfig.(!r.repo_tarring) then
       OpamFilename.make_tar_gz_job tarred_repo repo_root
     else Done None)
    @@+ function
    | Some e ->
      OpamStd.Exn.fatal e;
      Printf.ksprintf failwith
        "Failed to regenerate local repository archive: %s"
        (Printexc.to_string e)
    | None ->
      let opams =
        OpamRepositoryState.load_opams_from_dir repo.repo_name repo_root
      in
      let local_dir = OpamRepositoryPath.root gt.root repo.repo_name in
      if OpamRepositoryConfig.(!r.repo_tarring) then
        (if OpamFilename.exists_dir local_dir then
           (* Mark the obsolete local directory for deletion once we complete: it's
              no longer needed once we have a tar.gz *)
           Hashtbl.add rt.repos_tmp repo.repo_name (lazy local_dir))
      else if OpamFilename.exists tarred_repo then
        (OpamFilename.move_dir ~src:repo_root ~dst:local_dir;
         OpamFilename.remove tarred_repo);
      Done (Some (
          (* Return an update function to make parallel execution possible *)
          fun rt ->
            { rt with
              repositories =
                OpamRepositoryName.Map.add repo.repo_name repo rt.repositories;
              repos_definitions =
                OpamRepositoryName.Map.add repo.repo_name repo_file
                  rt.repos_definitions;
              repo_opams =
                OpamRepositoryName.Map.add repo.repo_name opams rt.repo_opams;
            }
        ))

let repositories rt repos =
  let command repo =
    OpamProcess.Job.catch
      (fun ex ->
         OpamStd.Exn.fatal ex;
         OpamConsole.error "Could not update repository %S: %s"
           (OpamRepositoryName.to_string repo.repo_name)
           (match ex with Failure s -> s | ex -> Printexc.to_string ex);
         Done ([repo], None)) @@
    fun () -> repository rt repo @@|
    fun f -> [], f
  in
  let merge (failed1, f1) (failed2, f2) =
    failed1 @ failed2,
    match f1, f2 with
    | None, None -> None
    | Some f1, Some f2 -> Some (f1 @* f2)
    | Some f, None | None, Some f -> Some f
  in
  let failed, rt_update =
    OpamParallel.reduce
      ~jobs:OpamStateConfig.(!r.dl_jobs)
      ~command ~merge
      ~nil:([], None)
      ~dry_run:OpamStateConfig.(!r.dryrun)
      repos
  in
  let rt =
    match rt_update with
    | Some rt_update ->
      let rt = rt_update rt in
      OpamRepositoryState.write_config rt;
      OpamRepositoryState.Cache.save rt;
      rt
    | None -> rt
  in
  failed, rt

let fetch_dev_package url srcdir ?(working_dir=false) ?subpath nv =
  let remote_url = OpamFile.URL.url url in
  let mirrors = remote_url :: OpamFile.URL.mirrors url in
  let checksum = OpamFile.URL.checksum url in
  log "updating %a" (slog (OpamUrl.to_string_w_subpath subpath)) remote_url;
(*
    (slog (OpamStd.Option.to_string OpamFilename.SubPath.pretty_string))
    subpath;
*)
  OpamRepository.pull_tree
    ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir))
    (OpamPackage.to_string nv) srcdir checksum ~working_dir ?subpath mirrors
  @@| OpamRepository.report_fetch_result nv

let pinned_package st ?version ?(autolock=false) ?(working_dir=false) name =
  log "update-pinned-package %s%a" (OpamPackage.Name.to_string name)
    (slog @@ function true -> " (working dir)" | false -> "") working_dir;
  let open OpamStd.Option.Op in
  let root = st.switch_global.root in
  let overlay_dir = OpamPath.Switch.Overlay.package root st.switch name in
  let overlay_opam = OpamFileTools.read_opam overlay_dir in
  match overlay_opam >>| fun opam -> opam, OpamFile.OPAM.url opam with
  | None | Some (_, None) -> Done ((fun st -> st), false)
  | Some (opam, Some urlf) ->
    let url = OpamFile.URL.url urlf in
    let subpath = OpamFile.URL.subpath urlf in
    let version =
      OpamFile.OPAM.version_opt opam ++
      version +!
      OpamPackage.Version.of_string "dev"
    in
    let nv = OpamPackage.create name version in
    let srcdir = OpamPath.Switch.pinned_package root st.switch name in
    (* Four versions of the metadata: from the old and new versions
       of the package, from the current overlay, and also the original one
       from the repo *)
    let add_extra_files srcdir file opam =
      if OpamFilename.dirname (OpamFile.filename file) <> srcdir
      then OpamFileTools.add_aux_files ~files_subdir_hashes:false opam
      else opam
    in
    let locked = if autolock then OpamFile.OPAM.locked opam else None in
    (* append subpath to source dir to retrieve opam files *)
    let srcdir_find = OpamFilename.SubPath.(srcdir /? subpath) in
    let old_source_opam_hash, old_source_opam =
      match OpamPinned.find_opam_file_in_source ?locked name srcdir_find with
      | None -> None, None
      | Some (f, lock) ->
        Some (OpamHash.compute (OpamFile.to_string f)),
        try
          Some (OpamFile.OPAM.read f |> OpamFile.OPAM.with_name name |>
                add_extra_files srcdir f |> OpamFile.OPAM.with_locked_opt lock)
        with e -> OpamStd.Exn.fatal e; None
    in
    let repo_opam =
      let packages =
        OpamPackage.Map.filter (fun nv _ -> nv.name = name) st.repos_package_index
      in
      (* get the latest version below v *)
      match OpamPackage.Map.split nv packages with
      | _, (Some opam), _ -> Some opam
      | below, None, _ when not (OpamPackage.Map.is_empty below) ->
        Some (snd (OpamPackage.Map.max_binding below))
      | _, None, above when not (OpamPackage.Map.is_empty above) ->
        Some (snd (OpamPackage.Map.min_binding above))
      | _ -> None
    in
    (if working_dir then Done () else
       (match url.OpamUrl.hash with
        | None -> Done true
        | Some h ->
          OpamRepository.current_branch url @@| fun branch -> branch = Some h)
       @@+ function false -> Done () | true ->
         OpamRepository.is_dirty ?subpath url
         @@| function false -> () | true ->
           OpamConsole.note
             "Ignoring uncommitted changes in %s%s \
              (`--working-dir' not specified or specified with no argument)."
             url.OpamUrl.path
             (OpamStd.Option.to_string (fun sp ->
                  Filename.dir_sep ^ OpamFilename.SubPath.to_string sp) subpath))
    @@+ fun () ->
    (* Do the update *)
    fetch_dev_package urlf srcdir ~working_dir ?subpath nv @@+ fun result ->
    let new_source_opam =
      OpamPinned.find_opam_file_in_source ?locked name srcdir_find
      >>= fun (f, lock) ->
      let warns, opam_opt = OpamFileTools.lint_file f in
      let warns, opam_opt = match opam_opt with
        | Some opam0 ->
          let opam = OpamFormatUpgrade.opam_file ~quiet:true ~filename:f opam0 in
          if opam <> opam0 then OpamFileTools.lint opam, Some opam
          else warns, Some opam0
        | None -> warns, opam_opt
      in
      if warns <> [] &&
         match old_source_opam_hash with
         | None -> true
         | Some h -> not (OpamHash.check_file (OpamFile.to_string f) h)
      then
        (OpamConsole.warning
           "%s opam file from upstream of %s:"
           (if opam_opt = None then "Fatal errors, not using"
            else "Failed checks in")
           (OpamConsole.colorise `bold (OpamPackage.Name.to_string name));
         OpamConsole.errmsg "%s\n"
           (OpamFileTools.warns_to_string warns));
      opam_opt >>| OpamFile.OPAM.with_name name >>| add_extra_files srcdir f
      >>| OpamFile.OPAM.with_locked_opt lock
    in
    let equal_opam a b =
      let cleanup_opam o =
        let v =
          (try
             Some ((OpamFile.OPAM.version_opt o)
                   +! (OpamSwitchState.get_package st name |> OpamPackage.version))
           with Not_found -> None)
          +! OpamPackage.Version.default
        in
        o |> OpamFile.OPAM.with_url_opt None
        |> OpamFile.OPAM.with_version v
      in
      OpamFile.OPAM.effectively_equal
        (cleanup_opam (OpamFormatUpgrade.opam_file a))
        (cleanup_opam (OpamFormatUpgrade.opam_file b))
    in
    let changed_opam old new_ = match old, new_ with
      | None, Some _ -> true
      | _, None -> false
      | Some a, Some b -> not (equal_opam a b)
    in
    let save_overlay opam =
      OpamFilename.mkdir overlay_dir;
      let opam_file = OpamPath.Switch.Overlay.opam root st.switch name in
      List.iter OpamFilename.remove
        OpamPath.Switch.Overlay.([
            OpamFile.filename opam_file;
            OpamFile.filename (url root st.switch name);
            OpamFile.filename (descr root st.switch name);
          ]);
      let files_dir = OpamPath.Switch.Overlay.files root st.switch name in
      OpamFilename.rmdir files_dir;
      let opam =
        OpamFile.OPAM.with_url urlf @@
        OpamFile.OPAM.with_name name opam
      in
      let opam =
        if OpamFile.OPAM.version_opt opam = None
        then OpamFile.OPAM.with_version version opam
        else opam
      in
      List.iter (fun (file, rel_file, hash) ->
          if OpamFilename.exists file &&
             OpamHash.check_file (OpamFilename.to_string file) hash then
            OpamFilename.copy ~src:file
              ~dst:(OpamFilename.create files_dir rel_file)
          else
            OpamConsole.warning "Ignoring file %s with invalid hash"
              (OpamFilename.to_string file))
        (OpamFile.OPAM.get_extra_files
           ~repos_roots:(OpamRepositoryState.get_root st.switch_repos)
           opam);
      OpamFile.OPAM.write opam_file
        (OpamFile.OPAM.with_extra_files_opt None opam);
      opam
    in
    match result, new_source_opam with
    | Result _, Some new_opam
      when changed_opam old_source_opam new_source_opam &&
           changed_opam overlay_opam new_source_opam ->
      log "Metadata from the package source of %s changed"
        (OpamPackage.to_string nv);
      let interactive_part st =
        if not (changed_opam old_source_opam overlay_opam) ||
           not (changed_opam repo_opam overlay_opam)
        then
          (* No manual changes *)
          (OpamConsole.formatted_msg
             "[%s] Installing new package description from upstream %s\n"
             (OpamConsole.colorise `green (OpamPackage.Name.to_string name))
             (OpamUrl.to_string url);
           let opam = save_overlay new_opam in
           OpamSwitchState.update_pin nv opam st)
        else if
          OpamConsole.formatted_msg
            "[%s] Conflicting update of the metadata from %s."
            (OpamConsole.colorise `green (OpamPackage.Name.to_string name))
            (OpamUrl.to_string url);
          OpamConsole.confirm "\nOverride files in %s (there will be a backup)?"
            (OpamFilename.Dir.to_string overlay_dir)
        then (
          let bak =
            OpamPath.backup_dir root / (OpamPackage.Name.to_string name ^ ".bak")
          in
          OpamFilename.mkdir (OpamPath.backup_dir root);
          OpamFilename.rmdir bak;
          OpamFilename.copy_dir ~src:overlay_dir ~dst:bak;
          OpamConsole.formatted_msg "User metadata backed up in %s\n"
            (OpamFilename.Dir.to_string bak);
          let opam = save_overlay new_opam in
          OpamSwitchState.update_pin nv opam st)
        else
          st
      in
      Done (interactive_part, true)
    | (Up_to_date _ | Not_available _), _ ->
      Done ((fun st -> st), false)
    | Result _, Some new_opam
      when not (changed_opam old_source_opam overlay_opam) ->
      (* The new opam is not _effectively_ different from the old, so no need to
         confirm, but use it still (e.g. descr may have changed) *)
      let opam = save_overlay new_opam in
      Done
        ((fun st -> {st with opams = OpamPackage.Map.add nv opam st.opams}),
         true)
    | Result  _, _ ->
      Done ((fun st -> st), true)

let dev_package st ?autolock ?working_dir nv =
  log "update-dev-package %a" (slog OpamPackage.to_string) nv;
  if OpamSwitchState.is_pinned st nv.name &&
     not (OpamSwitchState.is_version_pinned st nv.name) then
    pinned_package st ?autolock ~version:nv.version ?working_dir nv.name
  else
  match OpamSwitchState.url st nv with
  | None     -> Done ((fun st -> st), false)
  | Some url ->
    if (OpamFile.URL.url url).OpamUrl.backend = `http then
      Done ((fun st -> st), false)
    else
      fetch_dev_package url (OpamSwitchState.source_dir st nv)
        ?subpath:(OpamFile.URL.subpath url) ?working_dir nv
      @@| fun result ->
      (fun st -> st), match result with Result () -> true | _ -> false

let dev_packages st ?autolock ?(working_dir=OpamPackage.Set.empty) packages =
  log "update-dev-packages";
  let command nv =
    let working_dir = OpamPackage.Set.mem nv working_dir in
    OpamProcess.Job.ignore_errors
      ~default:(false, (fun st -> st), OpamPackage.Set.empty)
    @@ fun () ->
    dev_package st ?autolock ~working_dir nv @@| fun (st_update, changed) ->
    true, st_update, match changed with
    | true -> OpamPackage.Set.singleton nv
    | false -> OpamPackage.Set.empty
  in
  let merge (ok1, st_update1, set1) (ok2, st_update2, set2) =
    ok1 && ok2,
    (fun st -> st_update1 (st_update2 st)),
    OpamPackage.Set.union set1 set2
  in
  let success, st_update, updated_set =
    OpamParallel.reduce ~jobs:OpamStateConfig.(!r.dl_jobs)
      ~command
      ~merge
      ~nil:(true, (fun st -> st), OpamPackage.Set.empty)
      (OpamPackage.Set.elements packages)
  in
  let selections0 = OpamSwitchState.selections st in
  let st = st_update st in
  let st =
    OpamSwitchAction.add_to_reinstall st ~unpinned_only:false updated_set
  in
  (* The following is needed for pinned packages that may have changed
     version *)
  let selections1 = OpamSwitchState.selections st in
  if not (OpamTypesBase.switch_selections_equal selections0 selections1) then
    OpamFile.SwitchSelections.write
      (OpamPath.Switch.selections st.switch_global.root st.switch)
      selections1;
  success, st, updated_set

let pinned_packages st ?autolock ?(working_dir=OpamPackage.Name.Set.empty) names =
  log "update-pinned-packages";
  let command name =
    let working_dir = OpamPackage.Name.Set.mem name working_dir in
    OpamProcess.Job.ignore_errors
      ~default:((fun st -> st), OpamPackage.Name.Set.empty)
    @@ fun () ->
    pinned_package st ?autolock ~working_dir name @@| fun (st_update, changed) ->
    st_update,
    match changed with
    | true -> OpamPackage.Name.Set.singleton name
    | false -> OpamPackage.Name.Set.empty
  in
  let merge (st_update1, set1) (st_update2, set2) =
    (fun st -> st_update1 (st_update2 st)),
    OpamPackage.Name.Set.union set1 set2
  in
  let st_update, updates =
    OpamParallel.reduce
      ~jobs:(Lazy.force OpamStateConfig.(!r.jobs))
      ~command
      ~merge
      ~nil:((fun st -> st), OpamPackage.Name.Set.empty)
      (OpamPackage.Name.Set.elements names)
  in
  let st = st_update st in
  let updates =
    OpamPackage.Name.Set.fold (fun name acc ->
        OpamPackage.Set.add (OpamPinned.package st name) acc)
      updates OpamPackage.Set.empty
  in
  OpamSwitchAction.add_to_reinstall st ~unpinned_only:false updates,
  updates

let active_caches st nvs =
  let global_cache = OpamFile.Config.dl_cache st.switch_global.config in
  let rt = st.switch_repos in
  let repos_list = OpamSwitchState.repos_list st in
  let repo_cache =
    List.fold_left (fun (repos, caches as acc) nv ->
        match OpamRepositoryState.find_package_opt rt repos_list nv with
        | None -> acc
        | Some (repo, _) ->
          if List.mem repo repos then acc else
          let repo_def = OpamRepositoryName.Map.find repo rt.repos_definitions in
          let root_url = match OpamFile.Repo.root_url repo_def with
            | None -> OpamSystem.internal_error "repo file of unknown origin"
            | Some u -> u
          in
          let cache =
            OpamStd.List.filter_map (fun rel ->
                if OpamStd.String.contains ~sub:"://" rel
                then
                  let r = OpamUrl.parse_opt ~handle_suffix:false rel in
                  if r = None then
                    OpamConsole.warning "Invalid cache url %s, skipping" rel;
                  r
                else Some OpamUrl.Op.(root_url / rel))
              (OpamFile.Repo.dl_cache repo_def)
          in
          repo::repos, cache::caches)
      ([],[]) nvs
    |> snd
    |> List.rev
    |> List.flatten
  in
  global_cache @ repo_cache

let cleanup_source st old_opam_opt new_opam =
  let open OpamStd.Option.Op in
  let base_url urlf =
    let u = OpamFile.URL.url urlf in
    { u with OpamUrl.hash = None }
  in
  let url_remote opam = OpamFile.OPAM.url opam >>| base_url in
  let new_opam_o = url_remote new_opam in
  let old_opam_o = old_opam_opt >>= url_remote in
  let backend u = u.OpamUrl.backend in
  let clean =
    match new_opam_o >>| backend, old_opam_o >>| backend with
    | Some #OpamUrl.version_control, (Some #OpamUrl.version_control | None) ->
      false
    | _ -> new_opam_o <> old_opam_o
  in
  if clean then
    OpamFilename.rmdir
      (OpamSwitchState.source_dir st (OpamFile.OPAM.package new_opam))

let download_package_source_t st url nv_dirs =
  let cache_dir = OpamRepositoryPath.download_cache st.switch_global.root in
  let cache_urls = active_caches st (List.map fst nv_dirs) in
  let fetch_source_job =
    match url with
    | None -> Done None
    | Some url ->
      let dirnames =
        List.map (fun (nv, dir) ->
            OpamPackage.to_string nv, dir,
            OpamStd.Option.Op.(OpamSwitchState.opam st nv
                               |> OpamFile.OPAM.url
                               >>= OpamFile.URL.subpath))
          nv_dirs
      in
      let checksums = OpamFile.URL.checksum url in
      (OpamRepository.pull_shared_tree ~cache_dir ~cache_urls
         dirnames checksums
         (OpamFile.URL.url url :: OpamFile.URL.mirrors url))
      @@+ function
      | Not_available (_s,_l) as source_result
        when OpamFile.Config.swh_fallback st.switch_global.config ->
        (OpamDownload.SWHID.archive_fallback url dirnames
         @@| function
         | Result None -> Some source_result
         | Result (Some r) -> Some (Result r)
         | Not_available (s,l) -> Some (Not_available (s,l))
         | Up_to_date _ -> assert false)
      | source_result -> Done (Some source_result)
  in
  let fetch_extra_source_job (nv, name, u) = function
    | (_, _, Not_available _) :: _ as err -> Done err
    | ret ->
      (OpamRepository.pull_file_to_cache
         (OpamPackage.to_string nv ^"/"^ OpamFilename.Base.to_string name)
         ~cache_dir ~cache_urls
         (OpamFile.URL.checksum u)
         (OpamFile.URL.url u :: OpamFile.URL.mirrors u))
      @@| fun r -> (nv, OpamFilename.Base.to_string name, r) :: ret
  in
  fetch_source_job @@+ function
  | Some (Not_available _) as r -> Done (r, [])
  | r ->
    OpamProcess.Job.seq
      (List.map fetch_extra_source_job
         (List.flatten @@ List.map (fun (nv,_) ->
              List.map (fun (n,u) -> nv, n, u)
                (OpamFile.OPAM.extra_sources (OpamSwitchState.opam st nv)))
             nv_dirs))
      []
    @@| fun r1 -> r, r1

let download_shared_package_source st url nvs =
  download_package_source_t st url
    (List.map (fun nv -> nv, OpamSwitchState.source_dir st nv) nvs)

let download_package_source st nv dirname =
  download_package_source_t st
    (OpamFile.OPAM.url (OpamSwitchState.opam st nv))
    [nv, dirname]
  @@| fun (sources, extra_sources) ->
  sources,
  List.map (fun (_nv, name, failure) -> name, failure) extra_sources
OCaml

Innovation. Community. Security.