Compare commits

...
7 Commits
Author SHA1 Message Date
SowinskiBraeden 837ab5a0ba git remote management for v0.2.0
Document the commands that exist in this version.
2026-10-17 20:34:19 -07:00
SowinskiBraeden 1c77a078c4 test remote configuration against temporary repositories
Cover repository detection, fetch URL creation and changes, implicit push
preservation, idempotent adds, removal and collapsing, unknown remotes and
URLs that would be dangerous if git-fleet built shell command lines. Every
test runs in a temporary repository.
2026-10-11 15:03:52 -07:00
SowinskiBraeden 2d45601a68 report version 0.2.0 2026-10-02 22:17:33 -07:00
SowinskiBraeden b3a998d308 add remote status, add and remove commands
Expose status, add and remove through cmdliner, each defaulting to the
origin remote and accepting --remote. Expected failures print one line on
standard error and exit 1 instead of raising.
2026-09-28 16:41:05 -07:00
SowinskiBraeden fbf76e74ba plan push destination changes
Compute the git actions a request needs before running any of them, so a
dry run and a real run can never describe different changes. Adding the
first explicit push destination records the implicit one first, and
removing one collapses redundant configuration back to implicit pushing.
2026-09-24 21:08:47 -07:00
SowinskiBraeden efd03bd897 add git subprocess runner and remote model
Run git directly through Unix.create_process so that user supplied values
such as URLs stay separate argv entries, and model a remote as its fetch
URLs, its effective push destinations and its explicit pushurl entries.
2026-09-20 14:22:10 -07:00
SowinskiBraeden a09bc5f08c 0.1.0 project setup 2026-09-14 13:45:20 -07:00
18 changed files with 991 additions and 337 deletions

No files matched your search

+3
View File
@@ -0,0 +1,3 @@
_build/
_opam/
_install/
+7
View File
@@ -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.
+92 -40
View File
@@ -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
+5
View File
@@ -0,0 +1,5 @@
(executable
(name main)
(public_name git-fleet)
(package git-fleet)
(libraries git_fleet cmdliner))
+1
View File
@@ -0,0 +1 @@
let () = exit (Cmdliner.Cmd.eval' Git_fleet.Cli.cmd)
+27
View File
@@ -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")))
+34
View File
@@ -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"
-87
View File
@@ -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
View File
@@ -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 ]
+4
View File
@@ -0,0 +1,4 @@
(library
(name git_fleet)
(public_name git-fleet.lib)
(libraries cmdliner unix))
+194
View File
@@ -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
View File
@@ -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
View File
@@ -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
+33
View File
@@ -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. *)
+1
View File
@@ -0,0 +1 @@
let value = "0.2.0"
-210
View File
@@ -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()
+3
View File
@@ -0,0 +1,3 @@
(test
(name test_git_fleet)
(libraries git_fleet alcotest unix))
+259
View File
@@ -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 ] );
]