File: ben_download.ml

package info (click to toggle)
ben 0.7.4
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 520 kB
  • sloc: ml: 3,364; makefile: 88; ansic: 39
file content (134 lines) | stat: -rw-r--r-- 4,979 bytes parent folder | download
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
(**************************************************************************)
(*  Copyright © 2009 Stéphane Glondu <steph@glondu.net>                   *)
(*  Copyright © 2013 Johannes Schauer <j.schauer@email.de>                *)
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Affero General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version, with the additional   *)
(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
(*                                                                        *)
(*  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     *)
(*  Affero General Public License for more details.                       *)
(*                                                                        *)
(*  You should have received a copy of the GNU Affero General Public      *)
(*  License along with this program.  If not, see                         *)
(*  <http://www.gnu.org/licenses/>.                                       *)
(**************************************************************************)

open Printf
open Benl_core
open Benl_base
open Benl_error
open Benl_data
open Benl_modules
module Marshal = Benl_marshal.Make(Marshallable)
open Marshallable

let p = Benl_clflags.progress
let ( / ) = Filename.concat

let download_sources () =
  if !Benl_clflags.areas = [] then raise Nothing_to_download;
  let wquiet = if !Benl_clflags.verbose then "" else "-s" in
  let dst = !Benl_clflags.cache_dir/"Sources" in
  let tmp = Filename.temp_file "Sources." "" in
  let commands =
    Benl_parallel.map
      (fun area ->
         let url = sprintf "%s/dists/%s/%s/source/Sources%s"
           !Benl_clflags.mirror_sources
           !Benl_clflags.suite
           area
           (Benl_compression.extension !Benl_clflags.preferred_compression_format)
         in
         if !Benl_clflags.dry_run then p "Would download %s\n" url;
         let cmd = sprintf "{ curl -L %s %s | %s >> %s; }"
           wquiet
           (escape_for_shell url)
           (Benl_compression.display_tool !Benl_clflags.preferred_compression_format)
           tmp
         in cmd)
      !Benl_clflags.areas
  in
  let cmd = sprintf "%s && mv %s %s"
    (String.concat " && " commands) tmp dst
  in
  if not !Benl_clflags.dry_run then begin
    if not !Benl_clflags.verbose then p "Downloading Sources...";
    let r = Sys.command cmd in
    if not !Benl_clflags.verbose then p "\n";
    if r <> 0 then
      raise (Curl_error r)
    else
      FileUtil.rm ~force:FileUtil.Force [tmp]
  end;;

let download_binaries arch =
  if !Benl_clflags.areas = [] then raise Nothing_to_download;
  let wquiet = if !Benl_clflags.verbose then "" else "-s" in
  let dst = !Benl_clflags.cache_dir/"Packages_"^arch in
  let tmp = Filename.temp_file ("Packages.") "" in
  let commands =
    Benl_parallel.map
      (fun area ->
         let url = sprintf "%s/dists/%s/%s/binary-%s/Packages%s"
           !Benl_clflags.mirror_binaries
           !Benl_clflags.suite
           area
           arch
           (Benl_compression.extension !Benl_clflags.preferred_compression_format)
         in
         if !Benl_clflags.dry_run then p "Would download %s\n" url;
         let cmd = sprintf "{ curl -L %s %s | %s >> %s; }"
           wquiet
           (escape_for_shell url)
           (Benl_compression.display_tool !Benl_clflags.preferred_compression_format)
           tmp
         in
         cmd)
      !Benl_clflags.areas
  in
  let cmd = sprintf "%s && mv %s %s"
    (String.concat " && " commands) tmp dst
  in
  if not !Benl_clflags.dry_run then begin
    if not !Benl_clflags.verbose then p "Downloading Packages_%s..." arch;
    let r = Sys.command cmd in
    p "\n";
    if r <> 0 then
      raise (Curl_error r)
    else
      FileUtil.rm ~force:FileUtil.Force [tmp]
  end;;

let download_all architectures =
  download_sources ();
  Benl_parallel.iter download_binaries architectures;;

let save_cache () =
  if !Benl_clflags.use_cache then begin
    let src_raw = Benl_data.file_origin.get_sources M.empty in
    let bin_raw = Benl_parallel.fold
      Benl_data.file_origin.get_binaries
      PAMap.empty
      !Benl_clflags.architectures
      PAMap.fusion
    in
    let data = { src_map = src_raw; bin_map = bin_raw; } in
    let file = Benl_clflags.get_cache_file () in
    Marshal.dump file data;
  end

let main args =
  download_all !Benl_clflags.architectures;
  save_cache ()

let frontend = {
  Benl_frontend.name = "download";
  Benl_frontend.main = main;
  Benl_frontend.anon_fun = (fun _ -> ());
  Benl_frontend.help = [];
}