diff options
| -rw-r--r-- | context-readme.rst | 14 | ||||
| -rw-r--r-- | context_mirror_bot.ml | 69 |
2 files changed, 49 insertions, 34 deletions
diff --git a/context-readme.rst b/context-readme.rst new file mode 100644 index 0000000..3d716e9 --- /dev/null +++ b/context-readme.rst @@ -0,0 +1,14 @@ +----------------------------------------------------------------------- + Context Mirror +----------------------------------------------------------------------- + +This is a mirror repository of Context_, a document processing system +built around Donald E. Knuthâs TeX_. Inconveniently, Context is +supplied only as file archives and thus lacks version control. The +mirror aims at providing a source controlled repository to facilitate +common operations like bisection. Still no commit messages, though, +besides timestamps. + +.. _Context: http://www.pragma-ade.com +.. _TeX: http://www-cs-faculty.stanford.edu/~uno/abcde.html + diff --git a/context_mirror_bot.ml b/context_mirror_bot.ml index fd71688..ecebed5 100644 --- a/context_mirror_bot.ml +++ b/context_mirror_bot.ml @@ -26,7 +26,6 @@ ****************************************************************************** * * TODO - * * readme / license * * curl user agent * * logging * @@ -81,8 +80,8 @@ let ssh_wrapper = Filename.concat repo_root "git-ssh-wrapper.sh" let ssh_id = "context_mirror_bot_id_rsa" let ssh_id_dst = (Filename.concat repo_root ssh_id) let static_files = [ - ("context-license.txt", "COPYING") - (*("context-readme.txt", "README")*) + ("context-license.txt", "COPYING"); + ("context-readme.rst", "README") ] @@ -380,39 +379,41 @@ end = struct let import status = match status with - | Extract_ignored | Extract_failed _ -> Import_ignored - | Path { branch = branch; ts = ts; file = _; dst = dst } -> + | Extract_ignored | Extract_failed _ -> Import_ignored + | Path { branch = branch; ts = ts; file = _; dst = dst } -> + begin + ignore (list_of_pipe "git checkout origin"); + let needs_branch = match list_of_pipe ("git checkout " ^ branch) with + | None -> true + | Some _ -> false + in + msg (Printf.sprintf + "Importing %s into %s branch %s." + dst + (if needs_branch then "new" else "old") + branch); + match exec_commands [ (Printf.sprintf "rm -rf -- %s/*" repo_dir); + (Printf.sprintf "mv %s/* %s/" dst repo_dir); + (Printf.sprintf "git add --all %s/" repo_dir); + "git add --update"; + ] with + | Bad errmsg -> Import_failed errmsg + | Good -> begin - ignore (list_of_pipe "git checkout origin"); - let needs_branch = match list_of_pipe ("git checkout " ^ branch) with - | None -> true - | Some _ -> false - in - msg (Printf.sprintf - "Importing %s into %s branch %s." - dst - (if needs_branch then "new" else "old") - branch); - match exec_commands [ (Printf.sprintf "rm -rf -- %s/*" repo_dir); - (Printf.sprintf "mv %s/* %s/" dst repo_dir); - (Printf.sprintf "git add --all %s/" repo_dir); - "git add --update"; - ] with - | Bad errmsg -> Import_failed errmsg - | Good -> - begin - if needs_branch then - begin - match list_of_pipe (Printf.sprintf "git checkout -b %s" branch) with - | Some _ -> () - | None -> raise (Git_branch_failed branch) - end; - if import_static_files () = false then raise Import_files_failed; - match list_of_pipe (Printf.sprintf "git commit --message=\"%s\"" (format_time ts)) with - | Some _ -> gc (); Imported branch - | None -> raise (Git_commit_failed branch) - end + if needs_branch then + begin + match list_of_pipe (Printf.sprintf "git checkout -b %s" branch) with + | Some _ -> () + | None -> raise (Git_branch_failed branch) + end; + if import_static_files () = false then + raise Import_files_failed + else + match list_of_pipe (Printf.sprintf "git commit --message=\"%s\"" (format_time ts)) with + | Some _ -> gc (); Imported branch + | None -> raise (Git_commit_failed branch) end + end let push br = match list_of_pipe ("git checkout " ^ br) with |