Compare commits
7
Commits
15706a97f6
...
837ab5a0ba
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
837ab5a0ba | ||
|
|
1c77a078c4 | ||
|
|
2d45601a68 | ||
|
|
b3a998d308 | ||
|
|
fbf76e74ba | ||
|
|
efd03bd897 | ||
|
|
a09bc5f08c
|
No files matched your search
@@ -0,0 +1,3 @@
|
||||
_build/
|
||||
_opam/
|
||||
_install/
|
||||
@@ -0,0 +1,7 @@
|
||||
Copyright (c) 2026 Braeden Sowinski
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||
@@ -1,63 +1,115 @@
|
||||
# git-fleet
|
||||
|
||||
Small collection of Git utilities I use to keep my local repositories configured between my self-hosted Gitea instance and GitHub.
|
||||
A Git extension for managing repositories across multiple Git hosts and destinations.
|
||||
|
||||
Gitea is my primary Git server. GitHub is kept as a secondary/public copy of my repositories.
|
||||
`git-fleet` is a native CLI I'm building to simplify the Git workflows I use across self-hosted Git services and public hosts. The project started as a few personal scripts for configuring dual-push repositories and is being rebuilt in OCaml as a single, reusable command.
|
||||
|
||||
## `setup_dual_push.py`
|
||||
## Status
|
||||
|
||||
Scans my local Git repositories and updates repos owned by `SowinskiBraeden` to use:
|
||||
**v0.2.0: remote management**
|
||||
|
||||
- **Fetch:** `git.sowinski.dev`
|
||||
- **Push:** `git.sowinski.dev`
|
||||
- **Push:** `github.com`
|
||||
- `git fleet status`, `git fleet add` and `git fleet remove`
|
||||
- Multiple push destinations on a single remote
|
||||
- Preserves the destination a remote already pushed to
|
||||
- Collapses redundant configuration back to plain Git behaviour
|
||||
- `--dry-run` on every command that changes something
|
||||
- Git is run directly, never through a shell
|
||||
|
||||
Other repositories and repositories without a recognized origin are skipped.
|
||||
## How it works
|
||||
|
||||
Useful for configuring existing projects or setting up a new machine.
|
||||
`git-fleet` configures ordinary Git remotes. A remote fetches from one URL and may push to several, which is how a repository stays mirrored across more than one host:
|
||||
|
||||
## `git-new`
|
||||
|
||||
Small command for initializing new projects with my normal Git configuration.
|
||||
|
||||
Run it from inside the project directory:
|
||||
|
||||
```bash
|
||||
git-new <repo-name>
|
||||
```ini
|
||||
[remote "origin"]
|
||||
url = git@git.example.invalid:user/project.git
|
||||
fetch = +refs/heads/*:refs/remotes/origin/*
|
||||
pushurl = git@git.example.invalid:user/project.git
|
||||
pushurl = git@github.com:user/project.git
|
||||
```
|
||||
|
||||
It will:
|
||||
A remote with no `pushurl` pushes to the URL it fetches from. As soon as it has one `pushurl`, Git pushes only to the URLs listed there, so `git fleet add` writes out the existing destination before adding a new one. Removing a destination reverses that: when the only one left is the fetch URL, the redundant configuration is dropped.
|
||||
|
||||
Refuse to run if the directory is already inside a Git repository
|
||||
Initialize a new Git repository
|
||||
Set the default branch to main
|
||||
Set Gitea as the fetch origin
|
||||
Set Gitea and GitHub as push origins
|
||||
Every command works on `origin` unless `--remote` says otherwise.
|
||||
|
||||
The repo name does not need to match the local directory name.
|
||||
## Usage
|
||||
|
||||
## Setup
|
||||
Show where a remote fetches from and pushes to:
|
||||
|
||||
Make the script executable:
|
||||
|
||||
```bash
|
||||
chmod +x git-new
|
||||
```sh
|
||||
git fleet status
|
||||
git fleet status --remote upstream
|
||||
```
|
||||
|
||||
Symlink it into /usr/local/bin:
|
||||
|
||||
```bash
|
||||
sudo ln -s "$(pwd)/git-new" /usr/local/bin/git-new
|
||||
```
|
||||
origin
|
||||
fetch git@git.example.invalid:user/project.git
|
||||
push git@git.example.invalid:user/project.git
|
||||
push git@github.com:user/project.git
|
||||
```
|
||||
|
||||
It can then be used from any directory:
|
||||
Add a destination. With neither `--fetch` nor `--push`, the URL is added as a push destination. A remote that does not exist yet is created:
|
||||
|
||||
```bash
|
||||
mkdir my-project
|
||||
cd my-project
|
||||
|
||||
git-new my-repo-name
|
||||
```sh
|
||||
git fleet add git@github.com:user/project.git
|
||||
git fleet add git@git.example.invalid:user/project.git --fetch
|
||||
git fleet add git@git.example.invalid:user/project.git --fetch --push
|
||||
git fleet add git@github.com:user/project.git --remote upstream
|
||||
```
|
||||
|
||||
The repositories must already exist on Gitea and GitHub before pushing.
|
||||
Remove a push destination. URLs are matched exactly, as they appear in `git fleet status`:
|
||||
|
||||
```sh
|
||||
git fleet remove git@github.com:user/project.git
|
||||
```
|
||||
|
||||
Preview the Git commands instead of running them:
|
||||
|
||||
```sh
|
||||
git fleet add git@github.com:user/project.git --dry-run
|
||||
```
|
||||
|
||||
```
|
||||
Would change remote 'origin':
|
||||
git remote set-url --add --push origin git@git.example.invalid:user/project.git
|
||||
git remote set-url --add --push origin git@github.com:user/project.git
|
||||
```
|
||||
|
||||
Commands exit with `1` and a single line on standard error when something is wrong, such as running outside a repository or naming a remote that does not exist.
|
||||
|
||||
## Installation
|
||||
|
||||
Build a release binary and put it on your `PATH`:
|
||||
|
||||
```sh
|
||||
dune build --release
|
||||
install -Dm755 _build/default/bin/main.exe ~/.local/bin/git-fleet
|
||||
```
|
||||
|
||||
Git exposes any `git-*` executable on `PATH` as a subcommand, so `git-fleet` becomes:
|
||||
|
||||
```sh
|
||||
git fleet --help
|
||||
git fleet --version
|
||||
```
|
||||
|
||||
## Development
|
||||
|
||||
Install the project dependencies:
|
||||
|
||||
```sh
|
||||
opam install . --deps-only --with-test
|
||||
```
|
||||
|
||||
Build, test and run:
|
||||
|
||||
```sh
|
||||
dune build
|
||||
dune runtest
|
||||
dune exec git-fleet -- status
|
||||
```
|
||||
|
||||
The tests create temporary repositories and never change the configuration of this one.
|
||||
|
||||
## License
|
||||
|
||||
MIT
|
||||
@@ -0,0 +1,5 @@
|
||||
(executable
|
||||
(name main)
|
||||
(public_name git-fleet)
|
||||
(package git-fleet)
|
||||
(libraries git_fleet cmdliner))
|
||||
@@ -0,0 +1 @@
|
||||
let () = exit (Cmdliner.Cmd.eval' Git_fleet.Cli.cmd)
|
||||
@@ -0,0 +1,27 @@
|
||||
(lang dune 3.16)
|
||||
|
||||
(name git-fleet)
|
||||
(version 0.2.0)
|
||||
|
||||
(generate_opam_files true)
|
||||
|
||||
(source
|
||||
(github SowinskiBraeden/git-fleet))
|
||||
|
||||
(authors "Braeden Sowinski")
|
||||
(maintainers "Braeden Sowinski <braeden@sowinski.dev>")
|
||||
|
||||
(license MIT)
|
||||
|
||||
(package
|
||||
(name git-fleet)
|
||||
(synopsis "Manage Git repositories across multiple destinations")
|
||||
(description
|
||||
"git-fleet is a Git extension for managing repositories across multiple Git hosts and push destinations.")
|
||||
(depends
|
||||
(ocaml (>= 5.1))
|
||||
(dune (>= 3.16))
|
||||
(cmdliner (>= 1.3.0))
|
||||
(alcotest :with-test))
|
||||
(tags
|
||||
("git" "cli" "developer-tools")))
|
||||
@@ -0,0 +1,34 @@
|
||||
# This file is generated by dune, edit dune-project instead
|
||||
opam-version: "2.0"
|
||||
version: "0.2.0"
|
||||
synopsis: "Manage Git repositories across multiple destinations"
|
||||
description:
|
||||
"git-fleet is a Git extension for managing repositories across multiple Git hosts and push destinations."
|
||||
maintainer: ["Braeden Sowinski <braeden@sowinski.dev>"]
|
||||
authors: ["Braeden Sowinski"]
|
||||
license: "MIT"
|
||||
tags: ["git" "cli" "developer-tools"]
|
||||
homepage: "https://github.com/SowinskiBraeden/git-fleet"
|
||||
bug-reports: "https://github.com/SowinskiBraeden/git-fleet/issues"
|
||||
depends: [
|
||||
"ocaml" {>= "5.1"}
|
||||
"dune" {>= "3.16" & >= "3.16"}
|
||||
"cmdliner" {>= "1.3.0"}
|
||||
"alcotest" {with-test}
|
||||
"odoc" {with-doc}
|
||||
]
|
||||
build: [
|
||||
["dune" "subst"] {dev}
|
||||
[
|
||||
"dune"
|
||||
"build"
|
||||
"-p"
|
||||
name
|
||||
"-j"
|
||||
jobs
|
||||
"@install"
|
||||
"@runtest" {with-test}
|
||||
"@doc" {with-doc}
|
||||
]
|
||||
]
|
||||
dev-repo: "git+https://github.com/SowinskiBraeden/git-fleet.git"
|
||||
@@ -1,87 +0,0 @@
|
||||
#!/usr/bin/env python3
|
||||
|
||||
import subprocess
|
||||
import sys
|
||||
from pathlib import Path
|
||||
|
||||
OWNER = "SowinskiBraeden"
|
||||
GITEA_HOST = "git.sowinski.dev"
|
||||
GITHUB_HOST = "github.com"
|
||||
|
||||
|
||||
def git(*args: str, check: bool = True) -> subprocess.CompletedProcess:
|
||||
return subprocess.run(
|
||||
["git", *args],
|
||||
text=True,
|
||||
capture_output=True,
|
||||
check=check,
|
||||
)
|
||||
|
||||
|
||||
def main():
|
||||
if len(sys.argv) != 2:
|
||||
print("Usage: git-new <repo-name>")
|
||||
sys.exit(1)
|
||||
|
||||
repo_name = sys.argv[1].strip()
|
||||
|
||||
if not repo_name:
|
||||
print("Error: repository name cannot be empty.")
|
||||
sys.exit(1)
|
||||
|
||||
current_dir = Path.cwd()
|
||||
|
||||
# Refuse to run anywhere inside an existing Git repository.
|
||||
existing_repo = git("rev-parse", "--show-toplevel", check=False)
|
||||
|
||||
if existing_repo.returncode == 0:
|
||||
repo_root = existing_repo.stdout.strip()
|
||||
|
||||
print("Error: already inside a Git repository.")
|
||||
print(f"Repository root: {repo_root}")
|
||||
sys.exit(1)
|
||||
|
||||
gitea_url = f"git@{GITEA_HOST}:{OWNER}/{repo_name}.git"
|
||||
github_url = f"git@{GITHUB_HOST}:{OWNER}/{repo_name}.git"
|
||||
|
||||
print(f"Initializing: {current_dir}")
|
||||
print(f"Remote repo: {OWNER}/{repo_name}")
|
||||
print()
|
||||
|
||||
# Initialize repository.
|
||||
git("init")
|
||||
|
||||
# Use main as the initial branch.
|
||||
git("branch", "-m", "main")
|
||||
|
||||
# Gitea is canonical: fetch + first push destination.
|
||||
git("remote", "add", "origin", gitea_url)
|
||||
|
||||
git(
|
||||
"remote",
|
||||
"set-url",
|
||||
"--push",
|
||||
"origin",
|
||||
gitea_url,
|
||||
)
|
||||
|
||||
# GitHub is the secondary push destination.
|
||||
git(
|
||||
"remote",
|
||||
"set-url",
|
||||
"--add",
|
||||
"--push",
|
||||
"origin",
|
||||
github_url,
|
||||
)
|
||||
|
||||
print("Repository initialized.")
|
||||
print()
|
||||
print("Remotes:")
|
||||
print(f" fetch -> {gitea_url}")
|
||||
print(f" push -> {gitea_url}")
|
||||
print(f" push -> {github_url}")
|
||||
|
||||
|
||||
if __name__ == "__main__":
|
||||
main()
|
||||
+197
@@ -0,0 +1,197 @@
|
||||
open Cmdliner
|
||||
|
||||
let exit_error = 1
|
||||
|
||||
let fail message =
|
||||
prerr_endline ("git-fleet: " ^ message);
|
||||
exit_error
|
||||
|
||||
let report = function Ok () -> 0 | Error error -> fail (Git.string_of_error error)
|
||||
|
||||
let ( let* ) = Result.bind
|
||||
|
||||
let repository () =
|
||||
let cwd = Sys.getcwd () in
|
||||
if Git.is_repository ~cwd then Ok cwd else Error (Git.Not_a_repository cwd)
|
||||
|
||||
(* Only quote arguments that would otherwise be misread when pasted into a
|
||||
shell, so that ordinary Git URLs stay readable. *)
|
||||
let shell_safe = function
|
||||
| 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '@' | ':' | '/' | '.' | '_' | '-'
|
||||
| '+' | '~' | '=' ->
|
||||
true
|
||||
| _ -> false
|
||||
|
||||
let quote argument =
|
||||
if argument <> "" && String.for_all shell_safe argument then argument
|
||||
else Filename.quote argument
|
||||
|
||||
let print_action action =
|
||||
print_endline
|
||||
(" " ^ String.concat " " (List.map quote (Git.command_of_action action)))
|
||||
|
||||
let render_remote (remote : Git.remote) =
|
||||
let line label url = Printf.sprintf " %-5s %s" label url in
|
||||
String.concat "\n"
|
||||
((remote.name :: List.map (line "fetch") remote.fetch_urls)
|
||||
@ List.map (line "push") remote.push_urls)
|
||||
|
||||
let print_remote remote = print_endline (render_remote remote)
|
||||
|
||||
let show_remote ~cwd ~name =
|
||||
let* remote = Git.remote ~cwd ~name in
|
||||
print_remote remote;
|
||||
Ok ()
|
||||
|
||||
let run_plan ~cwd ~name ~dry_run ~unchanged plan =
|
||||
if plan = [] then (
|
||||
print_endline unchanged;
|
||||
Ok ())
|
||||
else if dry_run then (
|
||||
Printf.printf "Would change remote '%s':\n" name;
|
||||
List.iter print_action plan;
|
||||
Ok ())
|
||||
else
|
||||
let* () = Plan.execute ~cwd plan in
|
||||
show_remote ~cwd ~name
|
||||
|
||||
let remote_arg =
|
||||
let doc = "The Git remote to operate on." in
|
||||
Arg.(value & opt string "origin" & info [ "remote" ] ~docv:"REMOTE" ~doc)
|
||||
|
||||
let dry_run_arg =
|
||||
let doc = "Report the Git commands that would run, changing nothing." in
|
||||
Arg.(value & flag & info [ "dry-run" ] ~doc)
|
||||
|
||||
let url_arg ~doc = Arg.(required & pos 0 (some string) None & info [] ~docv:"URL" ~doc)
|
||||
|
||||
let status_term =
|
||||
let run name =
|
||||
report
|
||||
(let* cwd = repository () in
|
||||
show_remote ~cwd ~name)
|
||||
in
|
||||
Term.(const run $ remote_arg)
|
||||
|
||||
let status_cmd =
|
||||
let doc = "Show the destinations of a remote." in
|
||||
let man =
|
||||
[
|
||||
`S Manpage.s_description;
|
||||
`P
|
||||
"Print the fetch URL and every push destination of a remote. A remote \
|
||||
with no explicit push destination pushes to its fetch URL, and that \
|
||||
destination is shown as well.";
|
||||
`S Manpage.s_examples;
|
||||
`Pre "git fleet status";
|
||||
`Pre "git fleet status --remote upstream";
|
||||
]
|
||||
in
|
||||
Cmd.v (Cmd.info "status" ~doc ~man) status_term
|
||||
|
||||
let add_term =
|
||||
let fetch_arg =
|
||||
let doc = "Use $(i,URL) as the fetch URL of the remote." in
|
||||
Arg.(value & flag & info [ "fetch" ] ~doc)
|
||||
in
|
||||
let push_arg =
|
||||
let doc = "Add $(i,URL) as a push destination of the remote." in
|
||||
Arg.(value & flag & info [ "push" ] ~doc)
|
||||
in
|
||||
let run name fetch push dry_run url =
|
||||
report
|
||||
(let* cwd = repository () in
|
||||
let* plan = Plan.add ~cwd ~name ~fetch ~push ~url in
|
||||
let unchanged =
|
||||
Printf.sprintf "Remote '%s' already uses %s; nothing to change." name
|
||||
url
|
||||
in
|
||||
run_plan ~cwd ~name ~dry_run ~unchanged plan)
|
||||
in
|
||||
Term.(
|
||||
const run $ remote_arg $ fetch_arg $ push_arg $ dry_run_arg
|
||||
$ url_arg ~doc:"The Git URL to add.")
|
||||
|
||||
let add_cmd =
|
||||
let doc = "Add a destination to a remote." in
|
||||
let man =
|
||||
[
|
||||
`S Manpage.s_description;
|
||||
`P
|
||||
"Add a Git URL to a remote. With neither $(b,--fetch) nor $(b,--push) \
|
||||
the URL becomes a push destination.";
|
||||
`P
|
||||
"A remote that does not exist yet is created with $(i,URL) as its \
|
||||
fetch URL. When a remote gains its first explicit push destination, \
|
||||
the destination it already pushed to is kept, so that pushing \
|
||||
continues to reach it.";
|
||||
`S Manpage.s_examples;
|
||||
`Pre "git fleet add git@github.com:user/project.git";
|
||||
`Pre "git fleet add git@git.example.invalid:user/project.git --fetch --push";
|
||||
`Pre "git fleet add git@github.com:user/project.git --remote upstream";
|
||||
`Pre "git fleet add git@github.com:user/project.git --dry-run";
|
||||
]
|
||||
in
|
||||
Cmd.v (Cmd.info "add" ~doc ~man) add_term
|
||||
|
||||
let remove_term =
|
||||
let run name dry_run url =
|
||||
report
|
||||
(let* cwd = repository () in
|
||||
let* plan = Plan.remove ~cwd ~name ~url in
|
||||
let unchanged =
|
||||
Printf.sprintf "Remote '%s' does not push to %s; nothing to change."
|
||||
name url
|
||||
in
|
||||
run_plan ~cwd ~name ~dry_run ~unchanged plan)
|
||||
in
|
||||
Term.(
|
||||
const run $ remote_arg $ dry_run_arg
|
||||
$ url_arg ~doc:"The push destination to remove.")
|
||||
|
||||
let remove_cmd =
|
||||
let doc = "Remove a push destination from a remote." in
|
||||
let man =
|
||||
[
|
||||
`S Manpage.s_description;
|
||||
`P
|
||||
"Remove a push destination from a remote. The URL is matched exactly, \
|
||||
as it appears in $(b,git fleet status).";
|
||||
`P
|
||||
"When the only destination left is the remote's fetch URL, the \
|
||||
redundant configuration is removed and the remote returns to Git's \
|
||||
usual behaviour of pushing to where it fetches from.";
|
||||
`S Manpage.s_examples;
|
||||
`Pre "git fleet remove git@github.com:user/project.git";
|
||||
`Pre "git fleet remove git@github.com:user/project.git --remote upstream";
|
||||
`Pre "git fleet remove git@github.com:user/project.git --dry-run";
|
||||
]
|
||||
in
|
||||
Cmd.v (Cmd.info "remove" ~doc ~man) remove_term
|
||||
|
||||
let cmd =
|
||||
let doc = "Manage Git repositories across multiple destinations." in
|
||||
let man =
|
||||
[
|
||||
`S Manpage.s_description;
|
||||
`P
|
||||
"git-fleet manages the destinations of ordinary Git remotes. A remote \
|
||||
fetches from one URL and may push to several, which keeps a \
|
||||
repository mirrored across more than one Git host.";
|
||||
`P
|
||||
"Installed on $(b,PATH), git-fleet is available as $(b,git fleet). \
|
||||
Commands act on the remote $(b,origin) unless $(b,--remote) says \
|
||||
otherwise.";
|
||||
`S Manpage.s_examples;
|
||||
`Pre "git fleet status";
|
||||
`Pre "git fleet add git@github.com:user/project.git";
|
||||
`Pre "git fleet remove git@github.com:user/project.git";
|
||||
]
|
||||
in
|
||||
let exits =
|
||||
Cmd.Exit.info exit_error ~doc:"on a git-fleet error, such as an unknown remote."
|
||||
:: Cmd.Exit.defaults
|
||||
in
|
||||
let info = Cmd.info "git-fleet" ~version:Version.value ~doc ~man ~exits in
|
||||
let default = Term.ret (Term.const (`Help (`Pager, None))) in
|
||||
Cmd.group info ~default [ status_cmd; add_cmd; remove_cmd ]
|
||||
@@ -0,0 +1,4 @@
|
||||
(library
|
||||
(name git_fleet)
|
||||
(public_name git-fleet.lib)
|
||||
(libraries cmdliner unix))
|
||||
+194
@@ -0,0 +1,194 @@
|
||||
type error =
|
||||
| Git_unavailable of string
|
||||
| Not_a_repository of string
|
||||
| No_such_remote of string
|
||||
| Not_a_push_destination of { remote : string; url : string }
|
||||
| Implicit_push_destination of { remote : string; url : string }
|
||||
| Command_failed of { args : string list; status : int; stderr : string }
|
||||
|
||||
type remote = {
|
||||
name : string;
|
||||
fetch_urls : string list;
|
||||
push_urls : string list;
|
||||
explicit_push_urls : string list;
|
||||
}
|
||||
|
||||
type action =
|
||||
| Add_remote of { name : string; url : string }
|
||||
| Set_fetch_url of { name : string; url : string }
|
||||
| Add_push_url of { name : string; url : string }
|
||||
| Clear_push_urls of { name : string }
|
||||
|
||||
let executable = "git"
|
||||
|
||||
(* Read every pipe to end of file without blocking on one while the other
|
||||
fills up. *)
|
||||
let drain fds =
|
||||
let buffers = List.map (fun fd -> (fd, Buffer.create 1024)) fds in
|
||||
let chunk = Bytes.create 65536 in
|
||||
let rec loop open_fds =
|
||||
if open_fds <> [] then begin
|
||||
let ready =
|
||||
try
|
||||
let ready, _, _ = Unix.select open_fds [] [] (-1.0) in
|
||||
ready
|
||||
with Unix.Unix_error (Unix.EINTR, _, _) -> []
|
||||
in
|
||||
let finished =
|
||||
List.filter
|
||||
(fun fd ->
|
||||
match Unix.read fd chunk 0 (Bytes.length chunk) with
|
||||
| 0 -> true
|
||||
| n ->
|
||||
Buffer.add_subbytes (List.assq fd buffers) chunk 0 n;
|
||||
false
|
||||
| exception Unix.Unix_error (Unix.EINTR, _, _) -> false)
|
||||
ready
|
||||
in
|
||||
loop (List.filter (fun fd -> not (List.memq fd finished)) open_fds)
|
||||
end
|
||||
in
|
||||
loop fds;
|
||||
List.map (fun (_, buffer) -> Buffer.contents buffer) buffers
|
||||
|
||||
type output = { status : int; stdout : string; stderr : string }
|
||||
|
||||
(* Run [git] with [args] as distinct argv entries. No shell is involved. *)
|
||||
let exec args =
|
||||
let out_read, out_write = Unix.pipe ~cloexec:true () in
|
||||
let err_read, err_write = Unix.pipe ~cloexec:true () in
|
||||
let close_all () =
|
||||
List.iter
|
||||
(fun fd -> try Unix.close fd with Unix.Unix_error _ -> ())
|
||||
[ out_read; out_write; err_read; err_write ]
|
||||
in
|
||||
match
|
||||
let devnull = Unix.openfile Filename.null [ Unix.O_RDONLY ] 0 in
|
||||
Fun.protect
|
||||
~finally:(fun () -> Unix.close devnull)
|
||||
(fun () ->
|
||||
Unix.create_process executable
|
||||
(Array.of_list (executable :: args))
|
||||
devnull out_write err_write)
|
||||
with
|
||||
| exception Unix.Unix_error (code, _, _) ->
|
||||
close_all ();
|
||||
Error (Git_unavailable (Unix.error_message code))
|
||||
| pid ->
|
||||
Unix.close out_write;
|
||||
Unix.close err_write;
|
||||
let stdout, stderr =
|
||||
match drain [ out_read; err_read ] with
|
||||
| [ stdout; stderr ] -> (stdout, stderr)
|
||||
| _ -> ("", "")
|
||||
in
|
||||
Unix.close out_read;
|
||||
Unix.close err_read;
|
||||
let status =
|
||||
match snd (Unix.waitpid [] pid) with
|
||||
| Unix.WEXITED code -> code
|
||||
| Unix.WSIGNALED signal | Unix.WSTOPPED signal -> 128 + signal
|
||||
in
|
||||
Ok { status; stdout; stderr }
|
||||
|
||||
let failed args { status; stderr; _ } =
|
||||
Command_failed { args; status; stderr = String.trim stderr }
|
||||
|
||||
let in_repo ~cwd args = exec ("-C" :: cwd :: args)
|
||||
|
||||
(* Run a command that is expected to succeed, returning its standard output. *)
|
||||
let output ~cwd args =
|
||||
match in_repo ~cwd args with
|
||||
| Error _ as error -> error
|
||||
| Ok ({ status = 0; stdout; _ } : output) -> Ok stdout
|
||||
| Ok result -> Error (failed args result)
|
||||
|
||||
let lines text =
|
||||
String.split_on_char '\n' text
|
||||
|> List.map String.trim
|
||||
|> List.filter (fun line -> line <> "")
|
||||
|
||||
let unit_of_output result = Result.map (fun (_ : string) -> ()) result
|
||||
|
||||
let is_repository ~cwd =
|
||||
match in_repo ~cwd [ "rev-parse"; "--is-inside-work-tree" ] with
|
||||
| Ok { status = 0; stdout; _ } -> String.trim stdout = "true"
|
||||
| Ok _ | Error _ -> false
|
||||
|
||||
let remotes ~cwd = Result.map lines (output ~cwd [ "remote" ])
|
||||
|
||||
let remote_exists ~cwd ~name =
|
||||
Result.map (fun names -> List.mem name names) (remotes ~cwd)
|
||||
|
||||
(* [git remote get-url] fails when the remote is unknown; report that as a
|
||||
first class error rather than a raw command failure. *)
|
||||
let get_urls ~cwd ~name args =
|
||||
match in_repo ~cwd args with
|
||||
| Error _ as error -> error
|
||||
| Ok ({ status = 0; stdout; _ } : output) -> Ok (lines stdout)
|
||||
| Ok result -> (
|
||||
match remote_exists ~cwd ~name with
|
||||
| Ok false -> Error (No_such_remote name)
|
||||
| Ok true -> Error (failed args result)
|
||||
| Error _ as error -> error)
|
||||
|
||||
let get_fetch_urls ~cwd ~name =
|
||||
get_urls ~cwd ~name [ "remote"; "get-url"; "--all"; name ]
|
||||
|
||||
let get_push_urls ~cwd ~name =
|
||||
get_urls ~cwd ~name [ "remote"; "get-url"; "--push"; "--all"; name ]
|
||||
|
||||
let get_explicit_push_urls ~cwd ~name =
|
||||
let key = "remote." ^ name ^ ".pushurl" in
|
||||
let args = [ "config"; "--get-all"; key ] in
|
||||
match in_repo ~cwd args with
|
||||
| Error _ as error -> error
|
||||
| Ok ({ status = 0; stdout; _ } : output) -> Ok (lines stdout)
|
||||
(* Exit status 1 means the key is simply not set. *)
|
||||
| Ok { status = 1; _ } -> Ok []
|
||||
| Ok result -> Error (failed args result)
|
||||
|
||||
let ( let* ) = Result.bind
|
||||
|
||||
let remote ~cwd ~name =
|
||||
let* fetch_urls = get_fetch_urls ~cwd ~name in
|
||||
let* push_urls = get_push_urls ~cwd ~name in
|
||||
let* explicit_push_urls = get_explicit_push_urls ~cwd ~name in
|
||||
Ok { name; fetch_urls; push_urls; explicit_push_urls }
|
||||
|
||||
let command_of_action = function
|
||||
| Add_remote { name; url } -> [ "git"; "remote"; "add"; name; url ]
|
||||
| Set_fetch_url { name; url } -> [ "git"; "remote"; "set-url"; name; url ]
|
||||
| Add_push_url { name; url } ->
|
||||
[ "git"; "remote"; "set-url"; "--add"; "--push"; name; url ]
|
||||
| Clear_push_urls { name } ->
|
||||
[ "git"; "config"; "--unset-all"; "remote." ^ name ^ ".pushurl" ]
|
||||
|
||||
let apply ~cwd action =
|
||||
let args = List.tl (command_of_action action) in
|
||||
match action with
|
||||
| Clear_push_urls _ -> (
|
||||
match in_repo ~cwd args with
|
||||
| Error _ as error -> error
|
||||
(* Status 5 means there was nothing to unset. *)
|
||||
| Ok ({ status = 0 | 5; _ } : output) -> Ok ()
|
||||
| Ok result -> Error (failed args result))
|
||||
| Add_remote _ | Set_fetch_url _ | Add_push_url _ ->
|
||||
unit_of_output (output ~cwd args)
|
||||
|
||||
let string_of_error = function
|
||||
| Git_unavailable reason -> "could not run git: " ^ reason
|
||||
| Not_a_repository cwd -> "not a Git repository: " ^ cwd
|
||||
| No_such_remote name -> "no such remote: " ^ name
|
||||
| Not_a_push_destination { remote; url } ->
|
||||
Printf.sprintf "%s is not a push destination of remote '%s'" url remote
|
||||
| Implicit_push_destination { remote; url } ->
|
||||
Printf.sprintf
|
||||
"%s is the implicit push destination of remote '%s' and follows its \
|
||||
fetch URL; change the fetch URL instead"
|
||||
url remote
|
||||
| Command_failed { args; status; stderr } ->
|
||||
let command = String.concat " " ("git" :: args) in
|
||||
if stderr = "" then
|
||||
Printf.sprintf "%s exited with status %d" command status
|
||||
else Printf.sprintf "%s: %s" command stderr
|
||||
+64
@@ -0,0 +1,64 @@
|
||||
(** Execution of [git] subprocesses and inspection of repository remotes.
|
||||
|
||||
Every operation runs the [git] executable directly. User supplied values,
|
||||
such as URLs, are always passed as separate arguments and are never
|
||||
interpolated into a shell command line. *)
|
||||
|
||||
(** Failures that are expected during normal use of the command line. *)
|
||||
type error =
|
||||
| Git_unavailable of string
|
||||
(** The [git] executable could not be started. *)
|
||||
| Not_a_repository of string (** The directory is not a Git work tree. *)
|
||||
| No_such_remote of string (** The repository has no such remote. *)
|
||||
| Not_a_push_destination of { remote : string; url : string }
|
||||
(** The URL is not configured as a push destination of the remote. *)
|
||||
| Implicit_push_destination of { remote : string; url : string }
|
||||
(** The URL is the remote's implicit push destination, which follows its
|
||||
fetch URL and so cannot be removed on its own. *)
|
||||
| Command_failed of { args : string list; status : int; stderr : string }
|
||||
(** A [git] command exited with a non-zero status. *)
|
||||
|
||||
val string_of_error : error -> string
|
||||
(** A concise single line description, without a trailing newline. *)
|
||||
|
||||
(** A Git remote.
|
||||
|
||||
[push_urls] are the destinations Git actually pushes to. When a remote has
|
||||
no [remote.<name>.pushurl] entries, Git pushes to the fetch URL, so
|
||||
[explicit_push_urls] is empty while [push_urls] is not. *)
|
||||
type remote = {
|
||||
name : string;
|
||||
fetch_urls : string list;
|
||||
push_urls : string list;
|
||||
explicit_push_urls : string list;
|
||||
}
|
||||
|
||||
val is_repository : cwd:string -> bool
|
||||
(** Whether [cwd] is inside a Git work tree. *)
|
||||
|
||||
val remotes : cwd:string -> (string list, error) result
|
||||
(** The names of every configured remote, in Git's order. *)
|
||||
|
||||
val remote_exists : cwd:string -> name:string -> (bool, error) result
|
||||
val get_fetch_urls : cwd:string -> name:string -> (string list, error) result
|
||||
|
||||
val get_push_urls : cwd:string -> name:string -> (string list, error) result
|
||||
(** The effective push destinations, including the implicit one. *)
|
||||
|
||||
val get_explicit_push_urls :
|
||||
cwd:string -> name:string -> (string list, error) result
|
||||
(** The [remote.<name>.pushurl] entries, in configuration order. *)
|
||||
|
||||
val remote : cwd:string -> name:string -> (remote, error) result
|
||||
|
||||
(** A single change to a repository's configuration. *)
|
||||
type action =
|
||||
| Add_remote of { name : string; url : string }
|
||||
| Set_fetch_url of { name : string; url : string }
|
||||
| Add_push_url of { name : string; url : string }
|
||||
| Clear_push_urls of { name : string }
|
||||
|
||||
val command_of_action : action -> string list
|
||||
(** The equivalent Git command line, as an argument list starting with ["git"]. *)
|
||||
|
||||
val apply : cwd:string -> action -> (unit, error) result
|
||||
+67
@@ -0,0 +1,67 @@
|
||||
type t = Git.action list
|
||||
|
||||
let ( let* ) = Result.bind
|
||||
|
||||
(* Plan whatever is needed for [url] to become one of the remote's effective
|
||||
push destinations, leaving the existing destinations in place.
|
||||
|
||||
Git stops using the fetch URL as soon as a remote has an explicit pushurl,
|
||||
so the implicit destination has to be written out before the first explicit
|
||||
one is added. *)
|
||||
let ensure_push_destination ~name ~explicit ~effective ~url =
|
||||
let add url = Git.Add_push_url { name; url } in
|
||||
if List.mem url explicit then []
|
||||
else if explicit <> [] then [ add url ]
|
||||
else if effective = [ url ] then []
|
||||
else List.map add effective @ [ add url ]
|
||||
|
||||
let add ~cwd ~name ~fetch ~push ~url =
|
||||
(* With neither flag the URL is a push destination. *)
|
||||
let want_fetch = fetch and want_push = push || not fetch in
|
||||
let* exists = Git.remote_exists ~cwd ~name in
|
||||
if not exists then
|
||||
(* A new remote fetches and, implicitly, pushes to its only URL. *)
|
||||
Ok [ Git.Add_remote { name; url } ]
|
||||
else
|
||||
let* remote = Git.remote ~cwd ~name in
|
||||
let fetch_actions =
|
||||
if want_fetch && remote.fetch_urls <> [ url ] then
|
||||
[ Git.Set_fetch_url { name; url } ]
|
||||
else []
|
||||
in
|
||||
let push_actions =
|
||||
if not want_push then []
|
||||
else
|
||||
(* A changed fetch URL also moves the implicit push destination. *)
|
||||
let effective =
|
||||
if fetch_actions <> [] && remote.explicit_push_urls = [] then [ url ]
|
||||
else remote.push_urls
|
||||
in
|
||||
ensure_push_destination ~name ~explicit:remote.explicit_push_urls
|
||||
~effective ~url
|
||||
in
|
||||
Ok (fetch_actions @ push_actions)
|
||||
|
||||
let remove ~cwd ~name ~url =
|
||||
let* remote = Git.remote ~cwd ~name in
|
||||
if not (List.mem url remote.explicit_push_urls) then
|
||||
if remote.explicit_push_urls = [] && List.mem url remote.push_urls then
|
||||
Error (Git.Implicit_push_destination { remote = name; url })
|
||||
else Error (Git.Not_a_push_destination { remote = name; url })
|
||||
else
|
||||
let remaining =
|
||||
List.filter (fun existing -> existing <> url) remote.explicit_push_urls
|
||||
in
|
||||
let clear = Git.Clear_push_urls { name } in
|
||||
(* Dropping every explicit entry, or keeping only the fetch URL, restores
|
||||
Git's implicit push behaviour. *)
|
||||
if remaining = [] || remaining = remote.fetch_urls then Ok [ clear ]
|
||||
else
|
||||
Ok (clear :: List.map (fun url -> Git.Add_push_url { name; url }) remaining)
|
||||
|
||||
let execute ~cwd plan =
|
||||
List.fold_left
|
||||
(fun result action ->
|
||||
let* () = result in
|
||||
Git.apply ~cwd action)
|
||||
(Ok ()) plan
|
||||
@@ -0,0 +1,33 @@
|
||||
(** Working out which Git actions a request needs.
|
||||
|
||||
Planning is separated from execution so that a dry run and a real run
|
||||
describe exactly the same changes. A plan is applied in order; an empty
|
||||
plan means the repository is already in the requested state. *)
|
||||
|
||||
type t = Git.action list
|
||||
|
||||
val add :
|
||||
cwd:string ->
|
||||
name:string ->
|
||||
fetch:bool ->
|
||||
push:bool ->
|
||||
url:string ->
|
||||
(t, Git.error) result
|
||||
(** [add ~cwd ~name ~fetch ~push ~url] plans the addition of [url] to remote
|
||||
[name] as a fetch URL, a push destination, or both.
|
||||
|
||||
The remote is created when it does not exist yet. When the first explicit
|
||||
push destination is added, the remote's current implicit destination is
|
||||
recorded first, so that Git keeps pushing where it already pushed. Adding
|
||||
a destination that is already in use plans nothing. *)
|
||||
|
||||
val remove : cwd:string -> name:string -> url:string -> (t, Git.error) result
|
||||
(** [remove ~cwd ~name ~url] plans the removal of the push destination [url]
|
||||
from remote [name]. URLs are matched exactly.
|
||||
|
||||
When the only remaining explicit destination is the remote's fetch URL,
|
||||
the redundant entries are dropped so that the remote returns to Git's
|
||||
implicit push behaviour. *)
|
||||
|
||||
val execute : cwd:string -> t -> (unit, Git.error) result
|
||||
(** Apply every action in order, stopping at the first failure. *)
|
||||
@@ -0,0 +1 @@
|
||||
let value = "0.2.0"
|
||||
@@ -1,210 +0,0 @@
|
||||
#!/usr/bin/env python3
|
||||
|
||||
import re
|
||||
import subprocess
|
||||
from pathlib import Path
|
||||
|
||||
PROJECTS_DIR = Path.home() / "Projects"
|
||||
|
||||
OWNER = "SowinskiBraeden"
|
||||
GITHUB_HOST = "github.com"
|
||||
GITEA_HOST = "git.sowinski.dev"
|
||||
|
||||
|
||||
def git(repo: Path, *args: str, check: bool = True) -> subprocess.CompletedProcess:
|
||||
return subprocess.run(
|
||||
["git", "-C", str(repo), *args],
|
||||
text=True,
|
||||
capture_output=True,
|
||||
check=check,
|
||||
)
|
||||
|
||||
|
||||
def find_git_repositories(root: Path) -> list[Path]:
|
||||
"""Find all Git repositories recursively below root."""
|
||||
repositories = set()
|
||||
|
||||
for git_path in root.rglob(".git"):
|
||||
if git_path.is_dir() or git_path.is_file():
|
||||
repositories.add(git_path.parent)
|
||||
|
||||
return sorted(repositories)
|
||||
|
||||
|
||||
def parse_repo_name(url: str) -> str | None:
|
||||
"""
|
||||
Extract the repository name if the URL belongs to OWNER on either
|
||||
GitHub or our Gitea instance.
|
||||
|
||||
Supported examples:
|
||||
|
||||
git@github.com:SowinskiBraeden/example.git
|
||||
https://github.com/SowinskiBraeden/example.git
|
||||
|
||||
git@git.sowinski.dev:SowinskiBraeden/example.git
|
||||
https://git.sowinski.dev/SowinskiBraeden/example.git
|
||||
"""
|
||||
|
||||
hosts = [
|
||||
re.escape(GITHUB_HOST),
|
||||
re.escape(GITEA_HOST),
|
||||
]
|
||||
|
||||
host_pattern = "(?:" + "|".join(hosts) + ")"
|
||||
|
||||
patterns = [
|
||||
rf"^git@{host_pattern}:{re.escape(OWNER)}/([^/]+?)(?:\.git)?$",
|
||||
rf"^https?://{host_pattern}/{re.escape(OWNER)}/([^/]+?)(?:\.git)?/?$",
|
||||
rf"^ssh://git@{host_pattern}/{re.escape(OWNER)}/([^/]+?)(?:\.git)?/?$",
|
||||
]
|
||||
|
||||
for pattern in patterns:
|
||||
match = re.match(pattern, url)
|
||||
|
||||
if match:
|
||||
return match.group(1)
|
||||
|
||||
return None
|
||||
|
||||
|
||||
def get_origin(repo: Path) -> str | None:
|
||||
result = git(
|
||||
repo,
|
||||
"remote",
|
||||
"get-url",
|
||||
"origin",
|
||||
check=False,
|
||||
)
|
||||
|
||||
if result.returncode != 0:
|
||||
return None
|
||||
|
||||
return result.stdout.strip()
|
||||
|
||||
|
||||
def configure_repository(repo: Path) -> bool:
|
||||
origin = get_origin(repo)
|
||||
|
||||
if origin is None:
|
||||
print(f"SKIP {repo}")
|
||||
print(" No origin remote")
|
||||
return False
|
||||
|
||||
repo_name = parse_repo_name(origin)
|
||||
|
||||
if repo_name is None:
|
||||
print(f"SKIP {repo}")
|
||||
print(f" Unrecognized/non-{OWNER} origin:")
|
||||
print(f" {origin}")
|
||||
return False
|
||||
|
||||
gitea_url = f"git@{GITEA_HOST}:{OWNER}/{repo_name}.git"
|
||||
github_url = f"git@{GITHUB_HOST}:{OWNER}/{repo_name}.git"
|
||||
|
||||
print(f"UPDATE {repo}")
|
||||
print(f" Repository: {OWNER}/{repo_name}")
|
||||
|
||||
#
|
||||
# FETCH
|
||||
#
|
||||
# Gitea is authoritative.
|
||||
#
|
||||
git(
|
||||
repo,
|
||||
"remote",
|
||||
"set-url",
|
||||
"origin",
|
||||
gitea_url,
|
||||
)
|
||||
|
||||
print(f" fetch -> {gitea_url}")
|
||||
|
||||
#
|
||||
# PUSH
|
||||
#
|
||||
# Reset the push URL list so running this utility repeatedly cannot
|
||||
# create duplicate push destinations.
|
||||
#
|
||||
current_push_urls = git(
|
||||
repo,
|
||||
"remote",
|
||||
"get-url",
|
||||
"--all",
|
||||
"--push",
|
||||
"origin",
|
||||
).stdout.splitlines()
|
||||
|
||||
# Delete existing explicit push URLs.
|
||||
#
|
||||
# Git returns an error if there are no explicit push URLs matching,
|
||||
# which is harmless here.
|
||||
for push_url in current_push_urls:
|
||||
git(
|
||||
repo,
|
||||
"remote",
|
||||
"set-url",
|
||||
"--delete",
|
||||
"--push",
|
||||
"origin",
|
||||
re.escape(push_url),
|
||||
check=False,
|
||||
)
|
||||
|
||||
# Establish Gitea as the primary push destination.
|
||||
git(
|
||||
repo,
|
||||
"remote",
|
||||
"set-url",
|
||||
"--push",
|
||||
"origin",
|
||||
gitea_url,
|
||||
)
|
||||
|
||||
# GitHub remains the public/legacy destination.
|
||||
git(
|
||||
repo,
|
||||
"remote",
|
||||
"set-url",
|
||||
"--add",
|
||||
"--push",
|
||||
"origin",
|
||||
github_url,
|
||||
)
|
||||
|
||||
print(f" push -> {gitea_url}")
|
||||
print(f" push -> {github_url}")
|
||||
print()
|
||||
|
||||
return True
|
||||
|
||||
|
||||
def main():
|
||||
if not PROJECTS_DIR.exists():
|
||||
raise SystemExit(
|
||||
f"Projects directory does not exist: {PROJECTS_DIR}"
|
||||
)
|
||||
|
||||
repositories = find_git_repositories(PROJECTS_DIR)
|
||||
|
||||
print(f"Searching: {PROJECTS_DIR}")
|
||||
print(f"Found {len(repositories)} Git repositories.")
|
||||
print()
|
||||
|
||||
configured = 0
|
||||
skipped = 0
|
||||
|
||||
for repo in repositories:
|
||||
if configure_repository(repo):
|
||||
configured += 1
|
||||
else:
|
||||
skipped += 1
|
||||
|
||||
print("=" * 60)
|
||||
print("Finished")
|
||||
print(f"Configured: {configured}")
|
||||
print(f"Skipped: {skipped}")
|
||||
print(f"Total: {len(repositories)}")
|
||||
|
||||
|
||||
if __name__ == "__main__":
|
||||
main()
|
||||
@@ -0,0 +1,3 @@
|
||||
(test
|
||||
(name test_git_fleet)
|
||||
(libraries git_fleet alcotest unix))
|
||||
@@ -0,0 +1,259 @@
|
||||
open Git_fleet
|
||||
|
||||
let primary = "git@git.example.invalid:user/project.git"
|
||||
let github = "git@github.com:user/project.git"
|
||||
let backup = "git@backup.example.invalid:user/project.git"
|
||||
let urls = Alcotest.(list string)
|
||||
|
||||
let ok = function
|
||||
| Ok value -> value
|
||||
| Error error ->
|
||||
Alcotest.failf "unexpected error: %s" (Git.string_of_error error)
|
||||
|
||||
let error = function
|
||||
| Ok _ -> Alcotest.fail "expected an error"
|
||||
| Error error -> error
|
||||
|
||||
(* Arrange repository state with Git itself, so that the assertions do not
|
||||
depend on the code under test. *)
|
||||
let git_exn dir args =
|
||||
let argv = Array.of_list (("git" :: "-C" :: dir :: args)) in
|
||||
let input = Unix.openfile Filename.null [ Unix.O_RDONLY ] 0 in
|
||||
let output = Unix.openfile Filename.null [ Unix.O_WRONLY ] 0 in
|
||||
let pid = Unix.create_process "git" argv input output output in
|
||||
let _, status = Unix.waitpid [] pid in
|
||||
Unix.close input;
|
||||
Unix.close output;
|
||||
match status with
|
||||
| Unix.WEXITED 0 -> ()
|
||||
| _ -> Alcotest.failf "git %s failed" (String.concat " " args)
|
||||
|
||||
let rec remove_tree path =
|
||||
match Unix.lstat path with
|
||||
| exception Unix.Unix_error (Unix.ENOENT, _, _) -> ()
|
||||
| { st_kind = Unix.S_DIR; _ } ->
|
||||
Array.iter
|
||||
(fun entry -> remove_tree (Filename.concat path entry))
|
||||
(Sys.readdir path);
|
||||
Unix.rmdir path
|
||||
| _ -> Unix.unlink path
|
||||
|
||||
(* Temporary directories only: the git-fleet repository itself is never
|
||||
touched by the tests. *)
|
||||
let with_dir f =
|
||||
let dir = Filename.temp_dir "git-fleet-test" "" in
|
||||
Fun.protect ~finally:(fun () -> remove_tree dir) (fun () -> f dir)
|
||||
|
||||
let with_repo f =
|
||||
with_dir (fun dir ->
|
||||
git_exn dir [ "init"; "-q" ];
|
||||
f dir)
|
||||
|
||||
let with_origin f =
|
||||
with_repo (fun cwd ->
|
||||
git_exn cwd [ "remote"; "add"; "origin"; primary ];
|
||||
f cwd)
|
||||
|
||||
let add ?(name = "origin") ?(fetch = false) ?(push = false) ~cwd url =
|
||||
let plan = ok (Plan.add ~cwd ~name ~fetch ~push ~url) in
|
||||
ok (Plan.execute ~cwd plan);
|
||||
plan
|
||||
|
||||
let remove ?(name = "origin") ~cwd url =
|
||||
let plan = ok (Plan.remove ~cwd ~name ~url) in
|
||||
ok (Plan.execute ~cwd plan);
|
||||
plan
|
||||
|
||||
let explicit ?(name = "origin") cwd = ok (Git.get_explicit_push_urls ~cwd ~name)
|
||||
let effective ?(name = "origin") cwd = ok (Git.get_push_urls ~cwd ~name)
|
||||
let fetch_urls ?(name = "origin") cwd = ok (Git.get_fetch_urls ~cwd ~name)
|
||||
|
||||
let test_not_a_repository () =
|
||||
with_dir (fun dir ->
|
||||
Alcotest.(check bool) "outside a work tree" false (Git.is_repository ~cwd:dir))
|
||||
|
||||
let test_empty_repository () =
|
||||
with_repo (fun cwd ->
|
||||
Alcotest.(check bool) "inside a work tree" true (Git.is_repository ~cwd);
|
||||
Alcotest.(check urls) "no remotes" [] (ok (Git.remotes ~cwd)))
|
||||
|
||||
let test_create_origin () =
|
||||
with_repo (fun cwd ->
|
||||
let plan = add ~cwd primary in
|
||||
Alcotest.(check int) "one action" 1 (List.length plan);
|
||||
Alcotest.(check urls) "remotes" [ "origin" ] (ok (Git.remotes ~cwd));
|
||||
Alcotest.(check urls) "fetch" [ primary ] (fetch_urls cwd);
|
||||
Alcotest.(check urls) "effective push" [ primary ] (effective cwd);
|
||||
Alcotest.(check urls) "no explicit push" [] (explicit cwd))
|
||||
|
||||
let test_custom_remote_name () =
|
||||
with_repo (fun cwd ->
|
||||
ignore (add ~cwd ~name:"upstream" primary);
|
||||
Alcotest.(check urls) "remotes" [ "upstream" ] (ok (Git.remotes ~cwd));
|
||||
Alcotest.(check urls) "fetch" [ primary ] (fetch_urls ~name:"upstream" cwd))
|
||||
|
||||
let test_change_fetch_url () =
|
||||
with_origin (fun cwd ->
|
||||
ignore (add ~cwd ~fetch:true backup);
|
||||
Alcotest.(check urls) "fetch" [ backup ] (fetch_urls cwd);
|
||||
Alcotest.(check urls) "no explicit push" [] (explicit cwd);
|
||||
Alcotest.(check urls) "push follows fetch" [ backup ] (effective cwd))
|
||||
|
||||
let test_first_push_url_preserves_implicit () =
|
||||
with_origin (fun cwd ->
|
||||
ignore (add ~cwd github);
|
||||
Alcotest.(check urls)
|
||||
"implicit destination kept first" [ primary; github ] (explicit cwd);
|
||||
Alcotest.(check urls) "effective push" [ primary; github ] (effective cwd);
|
||||
Alcotest.(check urls) "fetch unchanged" [ primary ] (fetch_urls cwd))
|
||||
|
||||
let test_add_second_push_url () =
|
||||
with_origin (fun cwd ->
|
||||
ignore (add ~cwd github);
|
||||
ignore (add ~cwd backup);
|
||||
Alcotest.(check urls)
|
||||
"three destinations" [ primary; github; backup ] (explicit cwd))
|
||||
|
||||
let test_duplicate_push_url_is_idempotent () =
|
||||
with_origin (fun cwd ->
|
||||
ignore (add ~cwd github);
|
||||
let before = explicit cwd in
|
||||
let plan = add ~cwd github in
|
||||
Alcotest.(check int) "nothing planned" 0 (List.length plan);
|
||||
Alcotest.(check urls) "configuration unchanged" before (explicit cwd))
|
||||
|
||||
let test_implicit_destination_is_idempotent () =
|
||||
with_origin (fun cwd ->
|
||||
let plan = add ~cwd primary in
|
||||
Alcotest.(check int) "nothing planned" 0 (List.length plan);
|
||||
Alcotest.(check urls) "still implicit" [] (explicit cwd))
|
||||
|
||||
let test_remove_push_url () =
|
||||
with_origin (fun cwd ->
|
||||
ignore (add ~cwd github);
|
||||
ignore (add ~cwd backup);
|
||||
ignore (remove ~cwd github);
|
||||
Alcotest.(check urls) "order preserved" [ primary; backup ] (explicit cwd);
|
||||
Alcotest.(check urls) "fetch unchanged" [ primary ] (fetch_urls cwd))
|
||||
|
||||
let test_remove_collapses_to_implicit () =
|
||||
with_origin (fun cwd ->
|
||||
ignore (add ~cwd github);
|
||||
ignore (remove ~cwd github);
|
||||
Alcotest.(check urls) "redundant entry removed" [] (explicit cwd);
|
||||
Alcotest.(check urls) "pushes where it fetches" [ primary ] (effective cwd))
|
||||
|
||||
let test_remove_unknown_url () =
|
||||
with_origin (fun cwd ->
|
||||
ignore (add ~cwd github);
|
||||
match error (Plan.remove ~cwd ~name:"origin" ~url:backup) with
|
||||
| Git.Not_a_push_destination { remote = "origin"; url } ->
|
||||
Alcotest.(check string) "reported url" backup url
|
||||
| other -> Alcotest.failf "unexpected error: %s" (Git.string_of_error other))
|
||||
|
||||
let test_remove_implicit_destination () =
|
||||
with_origin (fun cwd ->
|
||||
match error (Plan.remove ~cwd ~name:"origin" ~url:primary) with
|
||||
| Git.Implicit_push_destination { remote = "origin"; url } ->
|
||||
Alcotest.(check string) "reported url" primary url
|
||||
| other -> Alcotest.failf "unexpected error: %s" (Git.string_of_error other))
|
||||
|
||||
let test_unknown_remote () =
|
||||
with_origin (fun cwd ->
|
||||
Alcotest.(check bool)
|
||||
"remote_exists" false
|
||||
(ok (Git.remote_exists ~cwd ~name:"upstream"));
|
||||
match error (Git.remote ~cwd ~name:"upstream") with
|
||||
| Git.No_such_remote name -> Alcotest.(check string) "name" "upstream" name
|
||||
| other -> Alcotest.failf "unexpected error: %s" (Git.string_of_error other))
|
||||
|
||||
let test_planning_changes_nothing () =
|
||||
with_origin (fun cwd ->
|
||||
let plan = ok (Plan.add ~cwd ~name:"origin" ~fetch:false ~push:true ~url:github) in
|
||||
Alcotest.(check int) "two actions planned" 2 (List.length plan);
|
||||
Alcotest.(check urls) "no explicit push url written" [] (explicit cwd);
|
||||
Alcotest.(check urls) "fetch untouched" [ primary ] (fetch_urls cwd);
|
||||
Alcotest.(check (list string))
|
||||
"equivalent git commands"
|
||||
[
|
||||
"git remote set-url --add --push origin " ^ primary;
|
||||
"git remote set-url --add --push origin " ^ github;
|
||||
]
|
||||
(List.map
|
||||
(fun action -> String.concat " " (Git.command_of_action action))
|
||||
plan))
|
||||
|
||||
let test_status_representation () =
|
||||
with_origin (fun cwd ->
|
||||
ignore (add ~cwd github);
|
||||
let remote = ok (Git.remote ~cwd ~name:"origin") in
|
||||
Alcotest.(check string)
|
||||
"rendered status"
|
||||
(String.concat "\n"
|
||||
[
|
||||
"origin";
|
||||
" fetch " ^ primary;
|
||||
" push " ^ primary;
|
||||
" push " ^ github;
|
||||
])
|
||||
(Cli.render_remote remote))
|
||||
|
||||
(* A URL that would run a command, or lose its meaning, if git-fleet built
|
||||
shell command lines out of user input. *)
|
||||
let test_hostile_url () =
|
||||
with_repo (fun cwd ->
|
||||
let marker = Filename.concat cwd "pwned" in
|
||||
let hostile =
|
||||
Printf.sprintf "ssh://git@example.invalid/a b;$(touch %s)`touch %s`.git"
|
||||
marker marker
|
||||
in
|
||||
ignore (add ~cwd primary);
|
||||
ignore (add ~cwd hostile);
|
||||
Alcotest.(check bool) "no command was executed" false (Sys.file_exists marker);
|
||||
Alcotest.(check urls) "stored verbatim" [ primary; hostile ] (explicit cwd);
|
||||
ignore (remove ~cwd hostile);
|
||||
Alcotest.(check urls) "removed exactly" [] (explicit cwd);
|
||||
Alcotest.(check urls) "fetch url intact" [ primary ] (fetch_urls cwd))
|
||||
|
||||
let test_version () =
|
||||
Alcotest.(check string) "version" "0.2.0" Version.value
|
||||
|
||||
let case name f = Alcotest.test_case name `Quick f
|
||||
|
||||
let () =
|
||||
(* Keep the developer's own Git configuration, such as url rewrites, out of
|
||||
the results. *)
|
||||
Unix.putenv "GIT_CONFIG_GLOBAL" Filename.null;
|
||||
Unix.putenv "GIT_CONFIG_SYSTEM" Filename.null;
|
||||
Alcotest.run "git-fleet"
|
||||
[
|
||||
( "repository",
|
||||
[
|
||||
case "outside a repository" test_not_a_repository;
|
||||
case "empty repository" test_empty_repository;
|
||||
case "unknown remote" test_unknown_remote;
|
||||
] );
|
||||
( "fetch urls",
|
||||
[
|
||||
case "creates origin" test_create_origin;
|
||||
case "custom remote name" test_custom_remote_name;
|
||||
case "changes the fetch url" test_change_fetch_url;
|
||||
] );
|
||||
( "push destinations",
|
||||
[
|
||||
case "first push url preserves the implicit one"
|
||||
test_first_push_url_preserves_implicit;
|
||||
case "adds a second push url" test_add_second_push_url;
|
||||
case "duplicate push url is idempotent" test_duplicate_push_url_is_idempotent;
|
||||
case "implicit destination is idempotent" test_implicit_destination_is_idempotent;
|
||||
case "removes a push url" test_remove_push_url;
|
||||
case "collapses to implicit push" test_remove_collapses_to_implicit;
|
||||
case "removing an unconfigured url fails" test_remove_unknown_url;
|
||||
case "removing the implicit destination fails" test_remove_implicit_destination;
|
||||
case "urls are never interpreted by a shell" test_hostile_url;
|
||||
] );
|
||||
( "planning",
|
||||
[ case "planning does not touch the repository" test_planning_changes_nothing ] );
|
||||
( "status", [ case "renders a remote" test_status_representation ] );
|
||||
( "version", [ case "reports 0.2.0" test_version ] );
|
||||
]
|
||||
Reference in new issue
Block a user