improve status messages

- Properly wrap *printf.
- Delimit interpolated strings.

1 files changed, 79 insertions, 76 deletions

diff --git a/context_mirror_bot.ml b/context_mirror_bot.ml
index 2ac9d97..749c0d3 100644
--- a/context_mirror_bot.ml
+++ b/context_mirror_bot.ml
@@ -80,7 +80,8 @@ let sources =
 let bot_owner       = "Philipp Gesang"
 let owner_contact   = "phg+robots@phi-gamma.net"
 
-let repo_root       = "/home/mirror/mirror"
+(*let repo_root       = "/home/mirror/mirror"*)
+let repo_root       = "/home/phg/src/context-mirror"
 let repo_subdir     = "context-git"
 let repo_dir        = Filename.concat repo_root repo_subdir
 let git_dir         = Filename.concat repo_dir ".git"
@@ -189,9 +190,15 @@ let verbosity = ref 0
 
 let set_verbosity n = verbosity := n
 
-let msg ?lev:(lev=0) str =
-  if !verbosity >= lev then
-    Printf.printf "[bot %s] %s\n%!" (timestamp ()) str
+let msg ?lev:(lev=0) =
+  Printf.(
+    if !verbosity < lev then
+      ifprintf stdout
+    else
+      let fin oc = output_char oc '\n'; flush oc in
+      let pp oc = kfprintf fin stdout in
+      kfprintf pp stdout "[bot %s] %!" (timestamp ())
+  )
 
 let err str =
   Printf.eprintf "[bot %s: error] %s\n%!" (timestamp ()) str
@@ -264,7 +271,7 @@ let list_of_pipe cmd =
    * keep the stderr around so as to prevent error messages
    * from flooding the terminal.
    *)
-  msg ~lev:1 (Printf.sprintf "exec “%s”" cmd);
+  msg ~lev:1 "exec “%s”" cmd;
   let (so, si, se) = open_process_full cmd (environment ()) in
   let rec aux acc =
     try
@@ -330,7 +337,7 @@ end = struct
   exception Copy_ssh_key_failed
 
   let write_config () =
-    msg ~lev:1 ("Write git configuration to " ^ git_config_file);
+    msg ~lev:1 "Write git configuration to [%s]" git_config_file;
     let oc = open_out_gen [Open_wronly; Open_creat; Open_trunc] 0o600 git_config_file in
     output_string oc gitconfig;
     close_out oc
@@ -362,7 +369,7 @@ end = struct
     aux static_files
 
   let init () =
-    msg ("Initializing new repository with state from " ^ bootstrap_repo);
+    msg "Initializing new repository with state from [%s]" bootstrap_repo;
     match exec_commands [
       "git init";
       "git remote add initial-source " ^ bootstrap_repo;
@@ -373,26 +380,26 @@ end = struct
       | Good -> install_files (); true
 
   let fetch remote =
-    msg ("Fetching remote " ^ remote);
+    msg "Fetching remote [%s]" remote;
     match list_of_pipe ("git fetch " ^ remote) with
     | None -> raise (Git_fetch_failed remote)
     | Some _ -> ()
 
   let pull ?rbr:(rbr="mirror") br =
-    msg ~lev:1 (Printf.sprintf "tentatively checkout new branch %s from remote %s" br rbr);
+    msg ~lev:1 "tentatively checkout new branch [%s] from remote [%s]" br rbr;
     let () = match list_of_pipe (* this fails if the branch already exists *)
               (Printf.sprintf "git checkout -b \"%s\" \"%s\"" br rbr) with
-    | Some _ -> msg (Printf.sprintf "new branch %s created" br)
+    | Some _ -> msg "new branch [%s] created" br
     | None -> (* branch exists, do regular checkout *)
         begin
-          msg ~lev:1 (Printf.sprintf "branch %s already exists; performing normal checkout" br);
+          msg ~lev:1 "branch [%s] already exists; performing normal checkout" br;
           match list_of_pipe (Printf.sprintf "git checkout \"%s\"" br) with
           | None -> raise (Git_checkout_failed br)
           | Some _ -> ()
         end
     in
     match list_of_pipe ("git pull --ff") with
-    | Some _ -> msg ~lev:1 (Printf.sprintf "pulled branch %s just fine" br)
+    | Some _ -> msg ~lev:1 "pulled branch %s just fine" br
     | None -> raise (Git_pull_failed (Printf.sprintf "%s (remote: %s)" br rbr))
 
   let last_commit br =
@@ -412,9 +419,9 @@ end = struct
       end
 
   let set_path path =
-    msg ~lev:1 (Printf.sprintf "GIT_WORK_TREE=%s" path);
-    msg ~lev:1 (Printf.sprintf "GIT_DIR=%s" git_dir);
-    msg ~lev:1 (Printf.sprintf "GIT_SSH=%s" ssh_wrapper);
+    msg ~lev:1 "GIT_WORK_TREE=%s" path;
+    msg ~lev:1 "GIT_DIR=%s" git_dir;
+    msg ~lev:1 "GIT_SSH=%s" ssh_wrapper;
     Unix.putenv "GIT_WORK_TREE" path;
     Unix.putenv "GIT_DIR" git_dir;
     Unix.putenv "GIT_SSH" ssh_wrapper
@@ -439,11 +446,8 @@ end = struct
           | None -> true
           | Some _ -> false
         in
-        msg (Printf.sprintf
-               "Importing %s into %s branch %s."
-               dst
-               (if needs_branch then "new" else "old")
-               branch);
+        msg "Importing [%s] into [%s] branch [%s]."
+          dst (if needs_branch then "new" else "old") branch;
         match exec_commands [
             (* remove current contents and replace it with the extracted files *)
             (Printf.sprintf "rm -rf -- %s/*" repo_dir);
@@ -511,15 +515,15 @@ let ensure_dir d =
       | _ -> raise (Bad_file "“%d” is not a directory.")
   with
     | Unix_error (err, _, _) when err = ENOENT ->
-        msg ("Creating directory " ^ d);
-        FileUtil.mkdir ~parent:true d
+      msg "Creating directory [%s]" d;
+      FileUtil.mkdir ~parent:true d
 
 let ensure_dst_repo d =
   if not (Git.is_repo ()) then
     if Git.init () then `New else `Fail
   else
     begin
-      msg ("Found existing repository at " ^ d);
+      msg "Found existing repository at [%s]" d;
       `Exists
     end
 
@@ -528,10 +532,10 @@ let copy_static_files () =
     (fun (src, _) ->
        let dst = Filename.concat repo_root src in
        if file_exists dst then
-         msg ~lev:1 (Printf.sprintf "File %s exists at %s, skipping." src dst)
+         msg ~lev:1 "File [%s] exists at [%s], skipping." src dst
        else
          begin
-           msg ~lev:1 (Printf.sprintf "Install %s exists to %s" src dst);
+           msg ~lev:1 "Install [%s] exists to [%s]" src dst;
            match list_of_pipe (Printf.sprintf "cp -f %s %s" src dst) with
            | None -> raise (Prepare_failed (Printf.sprintf "Error preparing file %s." src))
            | Some _ -> ()
@@ -555,7 +559,6 @@ let user_agent = Printf.sprintf
     bot_owner
     owner_contact
 
-
 let grab url writer =
   let open Curl in
   let c = init () in
@@ -620,10 +623,10 @@ let extract_timestamp src =
 
 let date_changed ts src =
   let repo_ts = extract_timestamp src in
-  msg (Printf.sprintf "ts: %s; repo_ts: %s -> %s"
+  msg "ts: %s; repo_ts: %s -> %s"
          (format_time ts)
          (format_time repo_ts)
-         (if ts <> repo_ts then "changed" else "unchanged"));
+         (if ts <> repo_ts then "changed" else "unchanged");
   if ts <> repo_ts then
     Changed repo_ts
   else
@@ -634,10 +637,10 @@ let download_zipball src =
   let dst = Filename.concat repo_root (src.name ^ ".zip") in
   if file_exists dst then
     begin
-      msg (Printf.sprintf "Destination file %s exists, removing." dst);
+      msg "Destination file [%s] exists, removing." dst;
       Unix.unlink dst
     end;
-  msg (Printf.sprintf "Downloading source archive %s" src.url);
+  msg "Downloading source archive [%s]" src.url;
   grab_file src.url dst;
   dst
 
@@ -660,7 +663,7 @@ let handle_zipball = function
   | Stagnation -> Extract_ignored "Nothing todo."
   | New_zip download ->
       begin
-        msg (Printf.sprintf "Extracting %s to %s" download.file download.dst);
+        msg "Extracting [%s] to [%s]" download.file download.dst;
         match unzip download.file download.dst with
           | Some _ -> Path download
           | None -> Extract_failed download.branch
@@ -675,31 +678,30 @@ let usage = Printf.sprintf "Usage:
 " self
 
 let run_status () =
-  if not (dir_exists repo_dir) then msg ("No directory at " ^ repo_dir) else
+  if not (dir_exists repo_dir) then
+    msg "No directory at [%s]" repo_dir else
     begin
       match list_of_pipe "git branch -a" with
-      | None -> msg ("No git repository at " ^ repo_dir)
-      | Some all_branches ->
-        let known = List.fold_left
-            (fun acc line ->
-               let l = String.length line in
-               if l < 3 then acc else
-                 begin
-                   let br = String.sub line 2 (l - 2) in
-                   if source_known br sources then
-                     br :: acc
-                   else
-                     acc
-                 end) [] all_branches
-        in
-        List.iter
-          (fun br ->
-             let tm = Git.last_commit br in
-             msg (Printf.sprintf
-                    "Found branch %7s with timestamp %s."
-                    br
-                    (format_time tm)))
-          known
+        | None -> msg "No git repository at [%s]" repo_dir
+        | Some all_branches ->
+          let known = List.fold_left
+              (fun acc line ->
+                 let l = String.length line in
+                 if l < 3 then acc else
+                   begin
+                     let br = String.sub line 2 (l - 2) in
+                     if source_known br sources then
+                       br :: acc
+                     else
+                       acc
+                   end) [] all_branches
+          in
+          List.iter
+            (fun br ->
+               let tm = Git.last_commit br in
+               msg "Found branch %7s with timestamp %s."
+                 br (format_time tm))
+            known
     end
 
 let run_check () =
@@ -707,26 +709,27 @@ let run_check () =
     (fun src ->
        let local_ts = Git.last_commit src.name in
        let upstream_ts = extract_timestamp src in
-       msg (Printf.sprintf "%s:" src.name);
-       msg (Printf.sprintf "    local:    %s" (format_time local_ts));
-       msg (Printf.sprintf "    upstream: %s%s"
+       msg "%s:" src.name;
+       msg "    local:    %s" (format_time local_ts);
+       msg "    upstream: %s%s"
               (format_time upstream_ts)
-              (if local_ts <> upstream_ts then " (new)" else "")))
+              (if local_ts <> upstream_ts then " (new)" else ""))
 
 let run_prepare () =
   ensure_dir repo_dir;
   copy_static_files ();
   match ensure_dst_repo repo_dir with
-  | `New -> msg (Printf.sprintf "Created new local repository at %s." repo_dir)
-  | `Exists -> msg (Printf.sprintf
-                      "Found local repository at %s,%s"
-                      repo_dir
-                      (List.fold_left
-                         (fun acc src -> (acc ^ Printf.sprintf
-                                            " %s: %s"
-                                            src.name
-                                            (format_time (Git.last_commit src.name))))
-                         "" sources))
+    | `New -> msg "Created new local repository at [%s]." repo_dir
+    | `Exists ->
+      msg
+        "Found local repository at %s,%s"
+        repo_dir
+        (List.fold_left
+           (fun acc src -> (acc ^ Printf.sprintf
+                              " %s: %s"
+                              src.name
+                              (format_time (Git.last_commit src.name))))
+           "" sources)
   | `Fail -> raise (Bad_env "Failed to initialize destination repository.")
 
 let run_download () =
@@ -744,10 +747,10 @@ let run_update () =
   let _ = List.iter
       (fun st ->
          match st with
-          | Import_ignored rationale -> msg rationale
+          | Import_ignored rationale -> msg "%s" rationale
           | Import_failed errmsg -> err errmsg
           | Imported br ->
-            msg (Printf.sprintf "Pushing %s to mirrors ..." br);
+            msg "Pushing [%s] to mirrors ..." br;
             match Git.push br with
               | Good -> msg "Success!"
               | Bad errmsg ->
@@ -773,9 +776,9 @@ let run_cleanup () =
   forall_sources
     (fun src ->
        let name = src.name in
-       msg (Printf.sprintf "Removing %s ->" name);
+       msg "Removing [%s] ->" name;
        List.iter (fun p ->
-           msg (Printf.sprintf "      %s" p);
+           msg "      [%s]" p;
            ignore (list_of_pipe ("rm -rf -- " ^ p)))
          [ mk_tmp_webpage name;
            Filename.concat repo_root name;
@@ -785,11 +788,11 @@ let run_push () =
   forall_sources
     (fun src ->
        let name = src.name in
-       msg (Printf.sprintf "Pushing branch %s to mirrors ..." name);
+       msg "Pushing branch [%s] to mirrors ..." name;
        match Git.push name with
-        | Good -> msg "Success!"
-        | Bad errmsg ->
-            err (Printf.sprintf "Failed to push %s: “%s”" name errmsg))
+         | Good -> msg "Success!"
+         | Bad errmsg ->
+           err (Printf.sprintf "Failed to push [%s]: “%s”" name errmsg))
 
 let run_files () = Git.install_files ()