Support Node.js mirrors (#36)

Fixes #32

executable/Env.re

@@ -29,7 +29,7 @@ let rec makeTemporarySymlink = () => {
   };
 };
 
-let run = (~shell, ~multishell) => {
+let run = (~shell, ~multishell, ~nodeDistMirror) => {
   open Lwt;
 
   Random.self_init();
@@ -41,10 +41,24 @@ let run = (~shell, ~multishell) => {
   switch (shell) {
   | System.Shell.Bash =>
     Printf.sprintf("export PATH=%s/bin:$PATH", path) |> Console.log;
-    Printf.sprintf("export FNM_MULTISHELL_PATH=%s", path) |> Console.log;
+    Printf.sprintf("export %s=%s", Config.FNM_MULTISHELL_PATH.name, path)
+    |> Console.log;
+    Printf.sprintf(
+      "export %s=%s",
+      Config.FNM_NODE_DIST_MIRROR.name,
+      nodeDistMirror,
+    )
+    |> Console.log;
   | System.Shell.Fish =>
     Printf.sprintf("set PATH %s/bin $PATH;", path) |> Console.log;
-    Printf.sprintf("set FNM_MULTISHELL_PATH %s;", path) |> Console.log;
+    Printf.sprintf("set %s %s;", Config.FNM_MULTISHELL_PATH.name, path)
+    |> Console.log;
+    Printf.sprintf(
+      "set %s %s",
+      Config.FNM_NODE_DIST_MIRROR.name,
+      nodeDistMirror,
+    )
+    |> Console.log;
   };
 
   Lwt.return();

executable/FnmApp.re

@@ -6,11 +6,12 @@ module Commands = {
   let listRemote = () => Lwt_main.run(ListRemote.run());
   let listLocal = () => Lwt_main.run(ListLocal.run());
   let install = version => Lwt_main.run(Install.run(~version));
-  let env = (isFishShell, isMultishell) =>
+  let env = (isFishShell, isMultishell, nodeDistMirror) =>
     Lwt_main.run(
       Env.run(
         ~shell=Fnm.System.Shell.(isFishShell ? Fish : Bash),
         ~multishell=isMultishell,
+        ~nodeDistMirror,
       ),
     );
 };
@@ -28,14 +29,21 @@ let help_secs = [
   `P("File bug reports at https://github.com/Schniz/fnm"),
 ];
 
-let envs = [
-  Term.env_info(
-    ~doc=
-      "The root directory of fnm installations. Defaults to: "
-      ++ Fnm.Directories.sfwRoot,
-    "FNM_DIR",
-  ),
-];
+let envs =
+  Fnm.Config.getDocs()
+  |> List.map(envVar =>
+       Fnm.Config.(
+         Term.env_info(
+           ~doc=
+             Printf.sprintf(
+               "%s\ndefaults to \"%s\"",
+               envVar.doc,
+               envVar.default,
+             ),
+           envVar.name,
+         )
+       )
+     );
 
 let install = {
   let doc = "Install another node version";
@@ -140,13 +148,22 @@ let env = {
     Arg.(value & flag & info(["fish"], ~doc));
   };
 
+  let nodeDistMirror = {
+    let doc = "https://nodejs.org/dist mirror";
+    Arg.(
+      value
+      & opt(string, "https://nodejs.org/dist")
+      & info(["node-dist-mirror"], ~doc)
+    );
+  };
+
   let isMultishell = {
     let doc = "Allow different Node versions for each shell";
     Arg.(value & flag & info(["multi"], ~doc));
   };
 
   (
-    Term.(const(Commands.env) $ isFishShell $ isMultishell),
+    Term.(const(Commands.env) $ isFishShell $ isMultishell $ nodeDistMirror),
     Term.info("env", ~version, ~doc, ~exits=Term.default_exits, ~man, ~sdocs),
   );
 };

feature_tests/existing_installation/run.sh

@@ -2,7 +2,9 @@
 
 eval `fnm env`
 
+echo "> Installing for the first time..."
 fnm install v8.11.3
+echo "> Installing the second time..."
 fnm install v8.11.3 | grep "already installed"
 
 if [ "$?" != "0" ]; then

feature_tests/node_mirror_installation/run.sh

@@ -0,0 +1,11 @@
+#!/bin/bash
+
+eval `fnm env --node-dist-mirror="https://npm.taobao.org/dist"`
+
+fnm install v8.11.3
+fnm use v8.11.3
+
+if [ "$(node -v)" != "v8.11.3" ]; then
+  echo "Node version is not v8.11.3!"
+  exit 1
+fi

library/Config.re

@@ -0,0 +1,65 @@
+type variable_doc('t) = {
+  name: string,
+  doc: string,
+  default: string,
+};
+
+module EnvVar =
+       (
+         M: {
+           type t;
+           let name: string;
+           let doc: string;
+           let default: t;
+           let parse: string => t;
+           let unparse: t => string;
+         },
+       ) => {
+  include M;
+  let getOpt = () => Sys.getenv_opt(name) |> Opt.map(parse);
+  let get = () => Opt.(getOpt() or default);
+  let docInfo = {name, doc, default: unparse(default)};
+};
+
+let ensureTrailingBackslash = str =>
+  switch (str.[String.length(str) - 1]) {
+  | '/' => str
+  | _ => str ++ "/"
+  };
+
+module FNM_NODE_DIST_MIRROR =
+  EnvVar({
+    type t = string;
+    let name = "FNM_NODE_DIST_MIRROR";
+    let doc = "https://nodejs.org/dist/ mirror";
+    let default = "https://nodejs.org/dist/";
+    let parse = ensureTrailingBackslash;
+    let unparse = ensureTrailingBackslash;
+  });
+
+module FNM_DIR =
+  EnvVar({
+    type t = string;
+    let parse = ensureTrailingBackslash;
+    let unparse = ensureTrailingBackslash;
+    let name = "FNM_DIR";
+    let doc = "The root directory of fnm installations.";
+    let default = {
+      let home =
+        Sys.getenv_opt("HOME")
+        |> Opt.orThrow("There isn't $HOME environment variable set.");
+      Filename.concat(home, ".fnm");
+    };
+  });
+
+module FNM_MULTISHELL_PATH =
+  EnvVar({
+    type t = string;
+    let parse = x => x;
+    let unparse = x => x;
+    let name = "FNM_MULTISHELL_PATH";
+    let doc = "Where the current node version link is stored";
+    let default = "";
+  });
+
+let getDocs = () => [FNM_DIR.docInfo, FNM_NODE_DIST_MIRROR.docInfo];

library/Directories.re

@@ -1,13 +1,4 @@
-let sfwRoot =
-  Opt.(
-    Sys.getenv_opt("FNM_DIR")
-    or {
-      let home =
-        Sys.getenv_opt("HOME")
-        |> Opt.orThrow("There isn't $HOME environment variable set.");
-      Filename.concat(home, ".fnm");
-    }
-  );
+let sfwRoot = Config.FNM_DIR.get();
 let nodeVersions = Filename.concat(sfwRoot, "node-versions");
 let globalCurrentVersion = Filename.concat(sfwRoot, "current");
 let currentVersion =

library/Http.re

@@ -6,34 +6,43 @@ type response = {
 let body = response => response.body;
 let status = response => response.status;
 
-let rec getBody = listOfStrings => {
+let rec getBody = listOfStrings =>
   switch (listOfStrings) {
   | [] => ""
   | ["", ...rest] => String.concat("\n", rest)
   | [_, ...xs] => getBody(xs)
   };
-};
 
-let getStatus = string => {
-  List.nth(String.split_on_char(' ', string), 1);
-};
+let getStatus = string =>
+  List.nth(String.split_on_char(' ', string), 1) |> int_of_string;
 
-exception Unknown_status_code(response);
+exception Unknown_status_code(int, response);
 exception Not_found(response);
 exception Internal_server_error(response);
 
-let verifyStatus = response => {
+let verifyStatus = response =>
   switch (response.status) {
   | 200 => Lwt.return(response)
   | x when x / 100 == 4 => Lwt.fail(Not_found(response))
   | x when x / 100 == 5 => Lwt.fail(Internal_server_error(response))
-  | _ => Lwt.fail(Unknown_status_code(response))
+  | x => Lwt.fail(Unknown_status_code(response.status, response))
+  };
+
+let rec skipRedirects = (~skipping=false, lines) =>
+  switch (skipping, lines) {
+  | (_, []) => failwith("Response is empty")
+  | (true, ["", ...xs]) => skipRedirects(~skipping=false, xs)
+  | (true, [x, ...xs]) => skipRedirects(~skipping=true, xs)
+  | (false, [x, ...xs])
+      when Str.first_chars(x, 4) == "HTTP" && getStatus(x) / 100 == 3 =>
+    skipRedirects(~skipping=true, xs)
+  | (false, xs) => xs
   };
-};
 
 let parseResponse = lines => {
-  let body = getBody(lines);
-  let status = getStatus(lines |> List.hd) |> int_of_string;
+  let linesAfterRedirect = skipRedirects(lines);
+  let body = getBody(linesAfterRedirect);
+  let status = getStatus(linesAfterRedirect |> List.hd);
   {body, status};
 };
 
@@ -47,7 +56,7 @@ let download = (url, ~into) => {
   let%lwt response =
     System.unix_exec(
       "curl",
-      ~args=[|url, "-D", "-", "--silent", "-o", into|],
+      ~args=[|url, "-L", "-D", "-", "--silent", "-o", into|],
     );
   response |> parseResponse |> verifyStatus;
 };

library/Versions.re

@@ -27,7 +27,10 @@ module Aliases = {
   let toDirectory = name => Filename.concat(Directories.aliases, name);
 
   let getAll = () => {
-    let%lwt aliases = Fs.readdir(Directories.aliases);
+    let%lwt aliases =
+      try%lwt (Fs.readdir(Directories.aliases)) {
+      | _ => Lwt.return([])
+      };
     aliases
     |> List.map(alias => {
          let fullPath = Filename.concat(Directories.aliases, alias);
@@ -102,7 +105,15 @@ module Remote = {
     |> Soup.select("pre a")
     |> Soup.to_list
     |> List.map(Soup.attribute("href"))
-    |> Core.List.filter_map(~f=x => x);
+    |> Core.List.filter_map(~f=x => x)
+    |> List.map(x => {
+         let parts = String.split_on_char('/', x) |> List.rev;
+         switch (parts) {
+         | ["", x, ...xs] => x ++ "/"
+         | [x, ...xs] => x
+         | [] => ""
+         };
+       });
 
   let downloadFileSuffix = ".tar.xz";
 
@@ -137,7 +148,10 @@ let getFileToDownload = (~version as versionName, ~os, ~arch) => {
     | _ => "v" ++ versionName
     | exception _ => versionName
     };
-  let url = "https://nodejs.org/dist/" ++ versionName ++ "/";
+
+  let url =
+    Printf.sprintf("%s%s/", Config.FNM_NODE_DIST_MIRROR.get(), versionName);
+
   let%lwt html =
     try%lwt (Http.makeRequest(url) |> Lwt.map(Http.body)) {
     | Http.Not_found(_) => Lwt.fail(Version_not_found(versionName))
@@ -171,29 +185,28 @@ let getCurrentVersion = () =>
   | exception (Unix.Unix_error(_, _, _)) => None
   };
 
-let getInstalledVersions = () =>
-  Lwt.(
-    {
-      let%lwt versions =
-        Fs.readdir(Directories.nodeVersions) >|= List.sort(Remote.compare)
-      and aliases = Aliases.byVersion();
-
-      versions
-      |> List.map(name =>
-           Local.{
-             name,
-             fullPath: Filename.concat(Directories.nodeVersions, name),
-             aliases:
-               Opt.(Aliases.VersionAliasMap.find_opt(name, aliases) or []),
-           }
-         )
-      |> Lwt.return;
-    }
-  );
+let getInstalledVersions = () => {
+  let%lwt versions =
+    Fs.readdir(Directories.nodeVersions)
+    |> Lwt.map(List.sort(Remote.compare))
+  and aliases = Aliases.byVersion();
+
+  versions
+  |> List.map(name =>
+       Local.{
+         name,
+         fullPath: Filename.concat(Directories.nodeVersions, name),
+         aliases: Opt.(Aliases.VersionAliasMap.find_opt(name, aliases) or []),
+       }
+     )
+  |> Lwt.return;
+};
 
 let getRemoteVersions = () => {
   let%lwt bodyString =
-    Http.makeRequest("https://nodejs.org/dist/") |> Lwt.map(Http.body);
+    Config.FNM_NODE_DIST_MIRROR.get()
+    |> Http.makeRequest
+    |> Lwt.map(Http.body);
 
   let versions = bodyString |> Remote.getRelativeLinksFromHTML;
   let%lwt installedVersions = Remote.getInstalledVersionSet();
@@ -208,7 +221,8 @@ let getRemoteVersions = () => {
        Remote.{
          name,
          installed: VersionSet.find_opt(name, installedVersions) != None,
-         baseURL: "https://nodejs.org/dist/" ++ name ++ "/",
+         baseURL:
+           Printf.sprintf("%s%s/", Config.FNM_NODE_DIST_MIRROR.get(), name),
        }
      )
   |> Lwt.return;

test/TestFramework.re

@@ -16,7 +16,11 @@ include Rely.Make({
 let run = args => {
   let arguments =
     args |> Array.append([|"./_build/default/executable/FnmApp.exe"|]);
-  let env = Unix.environment() |> Array.append([|"FNM_DIR=" ++ tmpDir|]);
+  let env =
+    Unix.environment()
+    |> Array.append([|
+         Printf.sprintf("%s=%s", Fnm.Config.FNM_DIR.name, tmpDir),
+       |]);
   let result =
     Lwt_process.pread_chars(~env, ("", arguments)) |> Lwt_stream.to_string;
   Lwt_main.run(result);

test/__snapshots__/Smoke_test.4d362c3c.0.snapshot

@@ -1,4 +1,5 @@
 Smoke test › env
 export PATH=<sfwRoot>/current/bin:$PATH
 export FNM_MULTISHELL_PATH=<sfwRoot>/current
+export FNM_NODE_DIST_MIRROR=https://nodejs.org/dist