(**************************************************************************)
(*  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 Ben.Core
open Ben.Error
open Data
open Ben.Modules
module Marshal = Ben.Marshal.Make (Marshallable)
open Marshallable

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

let release =
  lazy
    (let url =
       sprintf "%s/dists/%s/Release" !Clflags.mirror_sources !Clflags.suite
     in
     ("curl", [| "curl"; "--silent"; url |])
     |> Lwt_process.pread |> Lwt_main.run |> Utils.parse_release)

let automatic_components =
  lazy
    (let release = Lazy.force release in
     let r =
       match Ben.Stanza.find "components" release with
       | x -> String.split_on_char ' ' x
       | exception Not_found -> []
     in
     p "Automatically detected components: %s\n" (String.concat " " r);
     r)

let automatic_architectures =
  lazy
    (let release = Lazy.force release in
     let r =
       match Ben.Stanza.find "architectures" release with
       | x -> String.split_on_char ' ' x
       | exception Not_found -> []
     in
     let r = List.filter (fun x -> x <> "all") r in
     p "Automatically detected architectures: %s\n" (String.concat " " r);
     r)

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

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

let download_all architectures =
  let components =
    match !Clflags.components with
    | None -> Lazy.force automatic_components
    | Some x -> x
  in
  download_sources components;
  Ben.Parallel.iter (download_binaries components) architectures

let save_cache architectures =
  if !Clflags.use_cache then
    let file = Clflags.get_cache_file () in
    let () = p "Generating %s...\n" file in
    let origin = Data.file_origin () in
    let src_map = origin.get_sources M.empty in
    let bin_map =
      Ben.Parallel.map
        (fun arch -> origin.get_binaries PAMap.empty arch)
        architectures
    in
    let bin_map = List.fold_left PAMap.fusion PAMap.empty bin_map in
    let bin_map = Data.inject_build_status architectures src_map bin_map in
    let data = { src_map; bin_map } in
    Marshal.dump file data

let main () =
  let architectures =
    match !Clflags.debian_architectures with
    | None -> Lazy.force automatic_architectures
    | Some x -> x
  in
  download_all architectures;
  save_cache architectures

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

let archs_list () =
  let architectures =
    match !Clflags.debian_architectures with
    | None -> Lazy.force automatic_architectures
    | Some x -> x
  in
  architectures @ !Clflags.ignored_architectures
  |> uniq |> List.sort Stdlib.compare
