hans/git-cli
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Restarting

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-12 10:23:53 +02:00
parent 069fdbf921
commit 6f558868a1
11 changed files with 4 additions and 2451 deletions
Download Patch File Download Diff File Expand all files Collapse all files
README.md
-99
View File
@@ -47,102 +47,3 @@ documentation cross-reference index:
(git 'help 'grep)
(git 'help 'restore)
```
`raco setup git` builds and indexes the package documentation. The help command
builds a fresh cross-reference view for each request, so documentation generated
during the current DrRacket session is visible immediately. It uses the indexed
path and anchor instead of assuming a particular documentation directory.
## HTTPS credentials
Version 0.2 adds persistent HTTPS credentials. They are stored in the
`racket-git.ini` file in Racket's preferences directory. Tokens are encrypted
with AES-GCM using a key derived from the store password with
PBKDF2-HMAC-SHA256.
Create the credential store once:
```racket
(git 'credentials 'init "store password")
```
Store a token for a Git host:
```racket
(git 'credentials 'set
"https://git.dijkewijk.nl"
"hans"
token)
```
The host is used as the credential key, so the same entry is used for all HTTPS
repositories on that host.
The store is unlocked for one day by default:
```racket
(git 'credentials 'unlock "store password")
```
or for an explicit number of seconds:
```racket
(git 'credentials 'unlock "store password" (* 8 60 60))
```
The temporary unlock state is stored in `racket-git-unlock.ini` in Racket's
preferences directory, so it survives restarting DrRacket and starting a new
Racket process. Both files are opened through `simple-ini` with `#:private? #t`; on Unix this
restricts them to mode 0600 before sensitive contents are written. The cached
derived key grants access to the credentials until its expiry,
so `racket-git-unlock.ini` must be treated as sensitive during that period.
Lock immediately with:
```racket
(git 'credentials 'lock)
```
After credentials have been stored and the store is unlocked, normal remote
operations use them automatically:
```racket
(git 'fetch)
(git 'pull)
(git 'push)
;; Example while a real push is in progress:
;; [git] push origin/main: compressing 45% (37/82 objects)
;; [git] push origin/main: sending 58% (48/82 objects)
;; Suppress network progress when desired:
(git 'push #:quiet #t)
```
## Supported Git operations
Version 0.2 supports help, repository discovery, init, clone, status, diff, add, restore, reset, grep, config,
commit, branch, branch-current, switch, checkout, merge, lightweight tags, log, remotes, fetch,
fast-forward-only pull, push, tag push, network transfer progress, and HTTPS username/token credentials.
SSH credentials, merge/rebase pull, annotated tags, and submodules are not yet
part of this module.
Install from the package directory with:
```sh
raco pkg install .
```
## Recover a detached HEAD commit
```racket
(git 'branch-current) ; #f
(git 'branch-create "rescue-readme")
(git 'switch "main")
(git 'merge "rescue-readme")
(git 'status)
(dgit 'log 5)
(git 'push)
(git 'branch '-d "rescue-readme")
```
credentials.rkt
-230
View File
@@ -1,230 +0,0 @@
#lang racket/base
(require crypto
crypto/all
net/base64
racket/file
racket/string
simple-ini)
(provide git-credentials-store
git-credentials-unlock-store
current-git-credentials-store
current-git-credentials-unlock-store
git-credentials-init!
git-credentials-unlock!
git-credentials-lock!
git-credentials-unlocked?
git-credentials-unlock-expires
git-credentials-set!
git-credentials-ref
git-credentials-configured?
git-credentials-remove!)
(define git-credentials-store 'racket-git)
(define git-credentials-unlock-store 'racket-git-unlock)
;; Parameters make the storage location overridable for tests or embedded use,
;; while the public default remains the normal Racket preference stores.
(define current-git-credentials-store (make-parameter git-credentials-store))
(define current-git-credentials-unlock-store (make-parameter git-credentials-unlock-store))
(define settings-section 'settings)
(define unlock-section 'unlock)
(define kdf-iterations 200000)
(define cipher '(aes gcm))
(define check-text #"racket-git credential store")
(define-syntax-rule (with-git-crypto body ...)
(parameterize ([crypto-factories all-factories])
body ...))
(define (b64-encode bytes)
(bytes->string/utf-8 (base64-encode bytes #"")))
(define (b64-decode string)
(base64-decode (string->bytes/utf-8 string)))
(define (store-read name)
(file->ini name))
(define (store-write name ini)
(make-directory* (find-system-path 'pref-dir))
(ini->file ini name #:private? #t)
(void))
(define (store-set! name section key value)
(define ini (store-read name))
(ini-set! ini section key value)
(store-write name ini))
(define (store-get name section key [default #f])
(ini-get (store-read name) section key default))
(define (derive-key password salt)
(with-git-crypto
(pbkdf2-hmac 'sha256
(string->bytes/utf-8 password)
salt
#:iterations kdf-iterations
#:key-size 32)))
(define (encrypt-value key plaintext aad)
(with-git-crypto
(define iv (generate-cipher-iv cipher))
(define encrypted
(encrypt cipher key iv (string->bytes/utf-8 plaintext)
#:aad (string->bytes/utf-8 aad)))
(string-append (b64-encode iv) ":" (b64-encode encrypted))))
(define (decrypt-value key encoded aad)
(with-git-crypto
(define parts (string-split encoded ":"))
(unless (= (length parts) 2)
(error 'git-credentials "invalid encrypted credential data"))
(bytes->string/utf-8
(decrypt cipher key
(b64-decode (car parts))
(b64-decode (cadr parts))
#:aad (string->bytes/utf-8 aad)))))
(define (credential-key remote)
(define url-match
(regexp-match #px"^[A-Za-z][A-Za-z0-9+.-]*://(?:[^/@]+@)?([^/:]+)" remote))
(define ssh-match
(regexp-match #px"^[^@]+@([^:]+):" remote))
(string-downcase
(cond
[url-match (cadr url-match)]
[ssh-match (cadr ssh-match)]
[else remote])))
(define (string->hex string)
(apply string-append
(for/list ([b (in-bytes (string->bytes/utf-8 string))])
(let ([h (number->string b 16)])
(if (= (string-length h) 1) (string-append "0" h) h)))))
(define (credential-section remote)
;; simple-ini deliberately accepts a conservative section-name syntax.
;; Hex keeps arbitrary host names reversible and section-safe.
(string->symbol (string-append "credential."
(string->hex (credential-key remote)))))
(define (git-credentials-init! password #:unlock-for [seconds 86400])
(unless (and (string? password) (positive? (string-length password)))
(raise-argument-error 'git-credentials-init! "non-empty string?" password))
(define existing-salt (store-get (current-git-credentials-store) settings-section 'salt #f))
(when existing-salt
(error 'git-credentials-init! "credential store is already initialized"))
(define salt (with-git-crypto (crypto-random-bytes 16)))
(define key (derive-key password salt))
(define ini (store-read (current-git-credentials-store)))
(ini-set! ini settings-section 'version 1)
(ini-set! ini settings-section 'kdf "pbkdf2-hmac-sha256")
(ini-set! ini settings-section 'iterations kdf-iterations)
(ini-set! ini settings-section 'salt (b64-encode salt))
(ini-set! ini settings-section 'check
(encrypt-value key (bytes->string/utf-8 check-text) "check"))
(store-write (current-git-credentials-store) ini)
(cache-unlock-key! key seconds)
(void))
(define (cache-unlock-key! key seconds)
(unless (and (real? seconds) (> seconds 0))
(raise-argument-error 'git-credentials-unlock! "positive real?" seconds))
(define ini (store-read (current-git-credentials-unlock-store)))
(ini-set! ini unlock-section 'key (b64-encode key))
(ini-set! ini unlock-section 'expires (+ (current-seconds) seconds))
(store-write (current-git-credentials-unlock-store) ini)
(void))
(define (git-credentials-unlock! password #:for [seconds 86400])
(define salt-text (store-get (current-git-credentials-store) settings-section 'salt #f))
(define check (store-get (current-git-credentials-store) settings-section 'check #f))
(unless (and salt-text check)
(error 'git-credentials-unlock! "credential store is not initialized"))
(define key (derive-key password (b64-decode salt-text)))
(with-handlers ([exn:fail?
(lambda (_)
(error 'git-credentials-unlock! "invalid password"))])
(unless (string=? (decrypt-value key check "check")
(bytes->string/utf-8 check-text))
(error 'git-credentials-unlock! "invalid password")))
(cache-unlock-key! key seconds)
(void))
(define (git-credentials-lock!)
(define ini (store-read (current-git-credentials-unlock-store)))
(ini-set! ini unlock-section 'key "")
(ini-set! ini unlock-section 'expires 0)
(store-write (current-git-credentials-unlock-store) ini)
(void))
(define (git-credentials-unlock-expires)
(define expires (store-get (current-git-credentials-unlock-store) unlock-section 'expires 0))
(if (number? expires) expires 0))
(define (git-credentials-unlocked?)
(define key (store-get (current-git-credentials-unlock-store) unlock-section 'key ""))
(define expires (git-credentials-unlock-expires))
(cond
[(and (string? key)
(not (string=? key ""))
(> expires (current-seconds)))
#t]
[else
(when (and (number? expires) (positive? expires))
(git-credentials-lock!))
#f]))
(define (current-key who)
(unless (git-credentials-unlocked?)
(error who "credential store 'racket-git is locked"))
(b64-decode
(store-get (current-git-credentials-unlock-store) unlock-section 'key "")))
(define (git-credentials-set! remote username token)
(unless (string? remote)
(raise-argument-error 'git-credentials-set! "string?" remote))
(unless (string? username)
(raise-argument-error 'git-credentials-set! "string?" username))
(unless (string? token)
(raise-argument-error 'git-credentials-set! "string?" token))
(define key (current-key 'git-credentials-set!))
(define section (credential-section remote))
(define ini (store-read (current-git-credentials-store)))
(ini-set! ini section 'username username)
(ini-set! ini section 'token
(encrypt-value key token (string-append (credential-key remote) ":" username)))
(store-write (current-git-credentials-store) ini)
(void))
(define (git-credentials-configured? remote)
(define section (credential-section remote))
(define username (store-get (current-git-credentials-store) section 'username #f))
(define encrypted (store-get (current-git-credentials-store) section 'token #f))
(and (string? username) (not (string=? username ""))
(string? encrypted) (not (string=? encrypted ""))))
(define (git-credentials-ref remote)
(define section (credential-section remote))
(define username (store-get (current-git-credentials-store) section 'username #f))
(define encrypted (store-get (current-git-credentials-store) section 'token #f))
(cond
[(and (string? username) (not (string=? username ""))
(string? encrypted) (not (string=? encrypted "")))
(define key (current-key 'git-credentials-ref))
(cons username
(decrypt-value key encrypted (string-append (credential-key remote) ":" username)))]
[else #f]))
(define (git-credentials-remove! remote)
;; simple-ini has no section-delete primitive. Clearing both values keeps
;; the file format simple and makes git-credentials-ref return #f.
(define section (credential-section remote))
(define ini (store-read (current-git-credentials-store)))
(ini-set! ini section 'username "")
(ini-set! ini section 'token "")
(store-write (current-git-credentials-store) ini)
(void))
info.rkt
+3 -6
View File
@@ -1,17 +1,14 @@
#lang info
(define collection "git")
(define pkg-desc "Command-line-like Git operations for Racket, implemented with libgit2")
(define version "0.2.16")
(define collection "git-cli")
(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command")
(define version "0.3.1")
(define pkg-authors '("Hans Dijkema"))
(define license 'MIT)
(define deps
'("base"
"libgit2"
("simple-ini" #:version "0.3.3")
"crypto-lib"
"net-lib"
"racket-index"
"scribble-lib"
"racket-makefile"
main.rkt
-1369
View File
File diff suppressed because it is too large Load Diff
scribblings/git.scrbl
-267
View File
@@ -25,270 +25,3 @@ The short form is intended for build scripts and interactive use:
(git 'tag "v0.1")
(git 'checkout "main")
]
@defproc[(git [command symbol?] [#:quiet quiet any/c #f] [argument any/c] ...) any/c]{
Dispatches @racket[command] to the corresponding Git procedure. For example, @racket[(git 'status)] calls @racket[git-status], and @racket[(git 'commit "message")] calls @racket[git-commit]. Command names are ordinary symbols, so @racket[git] can safely be used inside other macros and DSLs. For network commands, @racket[#:quiet] suppresses progress output.
}
@defproc[(dgit [command symbol?] [#:quiet quiet any/c #f] [argument any/c] ...) any/c]{
Calls @racket[git], displays its result in a compact human-readable form, and returns the original result. Status entries are displayed with labels such as @tt{Modified}, @tt{New}, @tt{Deleted}, and @tt{Renamed}. Ignored files remain omitted, just as with @racket[git-status].
}
@racketblock[
(dgit 'status)
]
@section[#:tag "help"]{Help}
@defproc[(git-help [topic (or/c symbol? #f) #f]) void?]{Opens the installed Scribble documentation for this package in the default web browser. With a command topic, opens the section for that command. The command forms are @racket[(git 'help)] and @racket[(git 'help 'grep)].}
@racketblock[
(git 'help)
(git 'help 'grep)
(git 'help 'restore)
]
Help uses Racket's installed-documentation cross-reference database. It builds a fresh collection xref for each help request, resolves the documented binding through @racketmodname[setup/xref] and @racketmodname[scribble/xref], then opens the path and anchor recorded by @exec{raco setup}. This means a newly run @exec{raco setup git} is visible immediately in the same DrRacket session. No documentation directory is guessed or constructed by @racketmodname[git]. If the binding is not indexed, @racket[git-help] reports that @exec{raco setup git} should be run.
@section[#:tag "version"]{Version}
@defproc[(git-version) string?]{Returns the package version from @tt{info.rkt}. The command form is @racket[(git 'version)]. The version is not duplicated in @tt{main.rkt}; @tt{info.rkt} is the single source of truth.}
@racketblock[
(git 'version) ; => "0.2.16"
]
@section[#:tag "repository"]{Repository}
@defproc[(git-repository? [path path-string? (current-directory)]) boolean?]{Returns whether @racket[path] is inside a Git repository.}
@defproc[(git-root [path path-string? (current-directory)]) path?]{Returns the repository worktree root.}
@defproc[(git-init [path path-string? (current-directory)] [#:bare? bare? any/c #f]) path?]{Initializes a repository.}
@defproc*[([(git-clone [url string?] [#:quiet quiet any/c #f]) path?]
[(git-clone [url string?] [path path-string?] [#:quiet quiet any/c #f]) path?])]{Clones @racket[url]. If @racket[path] is omitted, a directory name is derived from the URL. Progress is written to the current output port unless @racket[quiet] is true.}
@section[#:tag "status"]{Status}
@defstruct*[git-status-entry ([path string?] [code string?] [flags list?])]{Describes one status entry. The @racket[code] field uses the familiar two-character Git status notation.}
@defproc[(git-status) (listof git-status-entry?)]{Returns worktree and index status.}
@defproc[(git-status-lines [entries (listof git-status-entry?) (git-status)]) (listof string?)]{Formats status entries as short Git-like lines.}
@defproc[(git-clean?) boolean?]{Returns @racket[#t] when @racket[git-status] is empty.}
@section[#:tag "diff"]{Diff}
@defproc*[([(git-diff) string?]
[(git-diff [option (or/c '--cached)]) string?])]{Returns a unified patch as a string. With no arguments it compares the index with the worktree, like @tt{git diff}. With @racket['--cached] it compares HEAD with the index, like @tt{git diff --cached}.}
@section[#:tag "add"]{Add}
@defproc[(git-add [path path-string?] ...) void?]{Stages the given paths. With no paths, stages the whole repository, including tracked removals. The command form @racket[(git 'add '-A)] stages all current status entries, including new, modified, and removed paths.}
@racketblock[
(git 'add '-A)
(git 'commit "Update all changed files")
]
@section[#:tag "restore"]{Restore}
@defproc[(git-restore [argument any/c] ...) void?]{Restores paths using Git-like command arguments. With only paths, the worktree is restored from the index, as in @tt{git restore path}. With @racket['--staged], matching index entries are restored from HEAD while the worktree is left untouched. @racket['--worktree] can be combined with @racket['--staged], and @racket['--source] selects another revision.}
@racketblock[
(git 'restore "main.rkt")
(git 'restore '--staged "scrbl/racket-makefile.bak")
(git 'restore '--source "HEAD~1" "main.rkt")
]
@section[#:tag "reset"]{Reset}
@defproc[(git-reset [argument any/c] ...) void?]{Resets HEAD, the index, or selected paths using Git-like command arguments. With @racket['--soft], @racket['--mixed], or @racket['--hard], the corresponding whole-repository reset is performed. Path resets use the familiar @tt{--} separator.}
@racketblock[
(git 'reset 'HEAD "--" "main.rkt")
(git 'reset '--mixed 'HEAD)
(git 'reset '--hard 'HEAD)
]
@section[#:tag "grep"]{Grep}
@defstruct*[git-grep-entry ([path string?] [line-number exact-positive-integer?] [line string?])]{Describes one line selected by @racket[git-grep]. Results are always structured this way, regardless of display-oriented flags such as @racket['-n], @racket['-l], or @racket['-c].}
@defproc[(git-grep [argument any/c] ...) (listof git-grep-entry?)]{Searches tracked files in the current worktree, or in an optional revision supplied after the pattern. String patterns are regular expressions. @racket['-i] makes matching case-insensitive and @racket['-v] inverts the match. The flags @racket['-n], @racket['-l], and @racket['-c] do not change the structured result; they control how @racket[dgit] displays it. Binary files are skipped. Racket's reader normally reads @tt{-i} as the complex number @racket[0-1i]; @racket[git-grep] deliberately recognizes that value in option position as Git's @tt{-i} flag, so the natural @racket['-i] spelling works.}
@racketblock[
(git 'grep "TODO")
(git 'grep '-i "todo")
(git 'grep '-v "generated")
(git 'grep "old-name" 'HEAD~1)
(dgit 'grep '-n "TODO") ; path:line-number:text
(dgit 'grep '-l "TODO") ; matching file names only
(dgit 'grep '-c "TODO") ; number of matching lines per file
]
@section[#:tag "config"]{Configuration}
@defproc*[([(git-config [key string?]) string?]
[(git-config [key string?] [value string?]) string?])]{Reads or writes a repository configuration value. The two-argument form returns @racket[value].}
@defproc[(git-head) (or/c string? #f)]{Returns the full OID of HEAD, or @racket[#f] for a repository without commits.}
@section[#:tag "commit"]{Commit}
@defproc[(git-commit [message string?]) string?]{Creates a commit from the index and returns its full OID. The author and committer are read from the repository configuration.}
@subsection[#:tag "git-prompt"]{Commit prompt}
@defproc[(git-prompt [message string? #f]) string?]{Returns @racket[message] when supplied. Without an argument, displays @tt{Give (commit) message: }, reads one line from the current input port, and returns it. This is convenient in interactive make targets before staging and committing changes.}
@section[#:tag "branches"]{Branches}
@defproc[(git-current-branch) (or/c string? #f)]{Returns the current local branch name, or @racket[#f] for detached HEAD. The command form is @racket[(git 'branch-current)].}
@defproc*[([(git-branch) (listof string?)]
[(git-branch [name string?]) string?])]{Lists local branches, or creates @racket[name] at HEAD.}
@defproc[(git-branch-create [name string?] [start-point string? "HEAD"]) string?]{Creates a local branch named @racket[name] at @racket[start-point] and returns @racket[name]. The default start point is the current HEAD, including detached HEAD. The command forms are @racket[(git 'branch-create name)] and @racket[(git 'branch-create name start-point)].}
@defproc[(git-branch-delete [name string?]) void?]{Deletes a local branch. The command form is @racket[(git 'branch '-d name)].}
@section[#:tag "switch-checkout"]{Switch and checkout}
@defproc[(git-switch [name string?]) (or/c string? #f)]{Switches to an existing local branch and attaches HEAD to that branch. The command form is @racket[(git 'switch name)]. An unknown local branch raises an exception.}
@defproc[(git-checkout [name string?]) (or/c string? #f)]{Checks out a local branch, tag, or commit. A tag or commit produces detached HEAD.}
@defproc[(git-checkout-new [name string?]) string?]{Creates and checks out a new branch.}
@section[#:tag "merge"]{Merge}
@defproc[(git-merge [name string?] [message (or/c string? #f) #f]) (or/c string? #f)]{Merges @racket[name] into the currently attached local branch. An up-to-date merge returns @racket[#f]. A fast-forward returns the new HEAD OID. A clean non-fast-forward merge creates a two-parent merge commit and returns its OID. If @racket[message] is @racket[#f], the merge commit message is @tt{Merge branch 'name'}. Conflicting merges raise an exception before changing HEAD or the worktree. The command forms are @racket[(git 'merge name)] and @racket[(git 'merge name message)].}
@section[#:tag "tags"]{Tags}
@defproc*[([(git-tag) (listof string?)]
[(git-tag [name string?]) string?])]{Lists tags, or creates a lightweight tag at HEAD and returns its OID.}
@defproc[(git-tag-delete [name string?]) void?]{Deletes a tag.}
@subsection{Recovering a commit made with detached HEAD}
A commit made while HEAD is detached is not attached to a local branch. The following sequence gives the commit a temporary branch name, switches back to @tt{main}, merges the rescued commit, verifies the result, pushes it, and removes the temporary branch:
@racketblock[
(git 'branch-current) ; => #f
(git 'branch-create "rescue-readme")
(git 'switch "main")
(git 'merge "rescue-readme")
(git 'status)
(dgit 'log 5)
(git 'push)
(git 'branch '-d "rescue-readme")
]
The @racket[(dgit 'log 5)] form is the compact Racket equivalent of using a short command-line log for verification: it displays the abbreviated commit OID and summary for the five newest commits.
@section[#:tag "log"]{Log}
@defstruct*[git-log-entry ([id string?] [summary string?] [time integer?])]{Describes one commit returned by @racket[git-log].}
@defproc[(git-log [max-count exact-nonnegative-integer? 20]) (listof git-log-entry?)]{Returns commits from HEAD in topological/time order.}
@defproc[(git-log-lines [entries (listof git-log-entry?) (git-log)]) (listof string?)]{Formats log entries as short OID plus summary.}
@section[#:tag "remotes"]{Remotes}
@defproc[(git-remotes) (listof string?)]{Lists remotes.}
@defproc[(git-remote-add [name string?] [url string?]) string?]{Adds a remote.}
@defproc[(git-remote-url [name string? "origin"]) string?]{Returns the remote URL.}
@defproc[(git-fetch [remote string? "origin"] [#:quiet quiet any/c #f]) void?]{Fetches the configured refspecs from a remote. Progress is written to the current output port unless @racket[quiet] is true.}
@defproc[(git-pull [remote string? "origin"] [#:quiet quiet any/c #f]) (or/c string? #f)]{Fetches and performs a fast-forward-only update of the current branch. Returns the new OID, or @racket[#f] when already up to date. A non-fast-forward update raises an exception.}
@defproc[(git-push [remote string? "origin"] [branch (or/c string? #f) #f] [#:quiet quiet any/c #f]) void?]{Pushes a branch to a branch with the same name. With no positional arguments, the current branch is pushed to @tt{origin}; with only @racket[remote], the current branch is pushed there. A start and completion message and transfer progress are written to the current output port unless @racket[quiet] is true. Progress callbacks only record transfer state; the libgit2 operation runs in a parallel Racket thread while the calling Racket thread performs output outside FFI callback context. Push progress distinguishes packing/compression from sending when libgit2 reports those phases.}
@defproc[(git-push-tag [tag string?] [remote string? "origin"] [#:quiet quiet any/c #f]) void?]{Pushes one tag. A start and completion message and transfer progress are written to the current output port unless @racket[quiet] is true. Progress callbacks only record transfer state; the libgit2 operation runs in a parallel Racket thread while the calling Racket thread performs output outside FFI callback context. Push progress distinguishes packing/compression from sending when libgit2 reports those phases.}
Remote HTTPS operations automatically use credentials from the @tt{racket-git} credential store when an entry exists for the remote host.
@section[#:tag "command-form"]{Command form}
The following command-like forms are supported directly:
@racketblock[
(git 'help)
(git 'help 'grep)
(git 'version)
(git 'init)
(git 'clone "https://example/repo.git")
(git 'status)
(git 'add "file.rkt")
(git 'add '-A)
(git 'restore '--staged "file.rkt")
(git 'reset 'HEAD "--" "file.rkt")
(git 'config "user.name" "Name")
(git 'commit "message")
(git 'branch-current)
(git 'branch)
(git 'branch "feature")
(git 'branch-create "rescue" "HEAD")
(git 'switch "feature")
(git 'merge "rescue")
(git 'branch '-d "feature")
(git 'checkout "main")
(git 'checkout '-b "feature")
(git 'tag)
(git 'tag "v0.1")
(git 'tag '-d "v0.1")
(git 'log 10)
(git 'remote)
(git 'remote 'add "origin" "https://example/repo.git")
(git 'remote 'get-url "origin")
(git 'fetch)
(git 'pull)
(git 'push)
(git 'push #:quiet #t)
(git 'push-tag "v0.1")
]
@section[#:tag "credentials"]{HTTPS credentials}
Git credentials are stored in @tt{racket-git.ini} in the normal Racket
preferences directory. Tokens are encrypted with AES-GCM. The encryption key is
derived from the store password with PBKDF2-HMAC-SHA256.
@defproc[(git-credentials-init! [password string?]
[#:unlock-for seconds real? 86400]) void?]{
Creates the credential store and leaves it unlocked for @racket[seconds].}
@defproc[(git-credentials-unlock! [password string?]
[#:for seconds real? 86400]) void?]{
Unlocks the credential store. The temporary unlock state is stored separately in
@tt{racket-git-unlock.ini}, allowing the unlock to survive restarting DrRacket
or starting another Racket process. Both credential INI files use
@racket[#:private? #t] storage from @racketmodname[simple-ini], which restricts
them to mode 0600 on Unix.}
@defproc[(git-credentials-lock!) void?]{Locks the credential store immediately.}
@defproc[(git-credentials-unlocked?) boolean?]{Returns whether a non-expired
unlock key is currently available.}
@defproc[(git-credentials-set! [remote string?] [username string?] [token string?]) void?]{
Stores an HTTPS username and token. Credentials are keyed by host.}
@defproc[(git-credentials-ref [remote string?]) (or/c #f pair?)]{
Returns the username/token pair for @racket[remote], or @racket[#f] when none is
stored. The store must be unlocked when a credential exists.}
@defproc[(git-credentials-remove! [remote string?]) void?]{Removes credentials
for the host represented by @racket[remote].}
tests/basic.rkt
-189
View File
@@ -1,189 +0,0 @@
#lang racket/base
(require rackunit
racket/file
git)
(define tmp (make-temporary-file "racket-git-test~a" 'directory))
(dynamic-wind
void
(lambda ()
(make-directory (build-path tmp "sub"))
(parameterize ([current-directory tmp])
(git 'init)
(check-true (git-repository?))
(check-equal? (git-current-branch) "master")
(check-equal? (git 'branch-current) "master")
(check-true (git-clean?))
(git 'config "user.name" "Racket Git Test")
(git 'config "user.email" "racket-git-test@example.invalid")
(check-equal? (git-config "user.name") "Racket Git Test")
(call-with-output-file ".gitignore"
#:exists 'truncate/replace
(lambda (out) (displayln "ignored.txt" out)))
(call-with-output-file "ignored.txt"
#:exists 'truncate/replace
(lambda (out) (displayln "ignored" out)))
(call-with-output-file (build-path "sub" "hello.txt")
#:exists 'truncate/replace
(lambda (out) (displayln "hello" out)))
(check-equal? (git-status-lines)
'("?? .gitignore" "?? sub/hello.txt"))
(define status-output (open-output-string))
(define displayed-status
(parameterize ([current-output-port status-output])
(dgit 'status)))
(check-equal? displayed-status (git 'status))
(check-equal? (get-output-string status-output)
"New - .gitignore\nNew - sub/hello.txt\n")
(check-false (regexp-match? #rx"ignored[.]txt"
(get-output-string status-output)))
(parameterize ([current-directory (build-path tmp "sub")])
(git 'add "hello.txt"))
(check-equal? (git-status-lines)
'("?? .gitignore" "A sub/hello.txt"))
(git 'add ".gitignore")
(define first (git-commit "initial commit"))
(check-equal? (string-length first) 40)
(check-true (git-clean?))
(check-equal? (git 'diff) "")
(check-equal? (git 'diff '--cached) "")
;; Grep always returns structured entries. -n, -l, and -c affect only
;; dgit presentation; -i and -v affect matching.
(define grep-hello (git 'grep "hello"))
(check-equal? grep-hello
(list (git-grep-entry "sub/hello.txt" 1 "hello")))
(check-equal? (git 'grep '-n "hello") grep-hello)
(check-equal? (git 'grep '-l "hello") grep-hello)
(check-equal? (git 'grep '-c "hello") grep-hello)
(check-equal? (git 'grep '-i "HELLO") grep-hello)
(check-false
(for/or ([entry (in-list (git 'grep '-v "hello"))])
(and (string=? (git-grep-entry-path entry) "sub/hello.txt")
(string=? (git-grep-entry-line entry) "hello"))))
(define grep-output (open-output-string))
(parameterize ([current-output-port grep-output])
(dgit 'grep '-n "hello"))
(check-equal? (get-output-string grep-output)
"sub/hello.txt:1:hello\n")
(define grep-files-output (open-output-string))
(parameterize ([current-output-port grep-files-output])
(dgit 'grep '-l "hello"))
(check-equal? (get-output-string grep-files-output)
"sub/hello.txt\n")
(define grep-count-output (open-output-string))
(parameterize ([current-output-port grep-count-output])
(dgit 'grep '-c "hello"))
(check-equal? (get-output-string grep-count-output)
"sub/hello.txt:1\n")
;; `restore --staged` removes a path from the index without deleting the
;; worktree file. Once the path is ignored, it disappears from status.
(call-with-output-file "staged.txt"
#:exists 'truncate/replace
(lambda (out) (displayln "staged" out)))
(git 'add "staged.txt")
(call-with-output-file ".gitignore"
#:exists 'append
(lambda (out) (displayln "staged.txt" out)))
(check-not-false
(member "A staged.txt" (git-status-lines)))
(git 'restore '--staged "staged.txt")
(check-false
(member "?? staged.txt" (git-status-lines)))
(check-true (file-exists? "staged.txt"))
;; Restore the tracked .gitignore from the index and remove the now
;; untracked test file, returning to a clean repository.
(git 'restore ".gitignore")
(delete-file "staged.txt")
(check-true (git-clean?))
(call-with-output-file (build-path "sub" "hello.txt")
#:exists 'truncate/replace
(lambda (out) (displayln "changed" out)))
(define worktree-diff (git 'diff))
(check-equal? (git 'grep "hello" 'HEAD)
(list (git-grep-entry "sub/hello.txt" 1 "hello")))
(check-equal? (git 'grep "changed")
(list (git-grep-entry "sub/hello.txt" 1 "changed")))
(check-true (regexp-match? #rx"-hello" worktree-diff))
(check-true (regexp-match? #rx"[+]changed" worktree-diff))
(check-equal? (git 'diff '--cached) "")
(define diff-output (open-output-string))
(parameterize ([current-output-port diff-output])
(dgit 'diff))
(check-equal? (get-output-string diff-output) worktree-diff)
(git 'add "sub/hello.txt")
(check-equal? (git 'diff) "")
(define cached-diff (git 'diff '--cached))
(check-true (regexp-match? #rx"-hello" cached-diff))
(check-true (regexp-match? #rx"[+]changed" cached-diff))
;; Path reset restores the index from HEAD but keeps the worktree edit.
(git 'reset 'HEAD "--" "sub/hello.txt")
(check-equal? (git 'diff '--cached) "")
(check-true (regexp-match? #rx"[+]changed" (git 'diff)))
(check-not-false
(member " M sub/hello.txt" (git-status-lines)))
(git 'add "sub/hello.txt")
(git 'commit "prepare branches")
(git 'checkout '-b "work")
(call-with-output-file (build-path "sub" "hello.txt")
#:exists 'truncate/replace
(lambda (out) (displayln "work" out)))
(git 'add)
(git 'commit "work change")
(check-equal? (file->string (build-path "sub" "hello.txt")) "work\n")
(check-equal? (git 'branch-current) "work")
(git 'switch "master")
(check-equal? (file->string (build-path "sub" "hello.txt")) "changed\n")
(check-equal? (git-current-branch) "master")
(check-not-false (member "work" (git 'branch)))
;; Safe checkout must not overwrite an uncommitted tracked change.
(call-with-output-file (build-path "sub" "hello.txt")
#:exists 'truncate/replace
(lambda (out) (displayln "dirty" out)))
(check-exn exn:fail? (lambda () (git 'switch "work")))
(check-equal? (git-current-branch) "master")
(check-equal? (file->string (build-path "sub" "hello.txt")) "dirty\n")
(call-with-output-file (build-path "sub" "hello.txt")
#:exists 'truncate/replace
(lambda (out) (displayln "changed" out)))
(git 'branch '-d "work")
(check-false (member "work" (git 'branch)))
(define tag-id (git 'tag "v0.1"))
(check-equal? (string-length tag-id) 40)
(check-equal? (git 'tag) '("v0.1"))
(git 'checkout "v0.1")
(check-false (git-current-branch))
(check-false (git 'branch-current))
(check-exn exn:fail? (lambda () (git 'switch "missing")))
(git 'switch "master")
(check-equal? (git 'branch-current) "master")
(git 'tag '-d "v0.1")
(check-equal? (git 'tag) '())
(check-equal? (length (git 'log 10)) 2)))
(lambda ()
(delete-directory/files tmp)))
;; Help validates its topic before trying to open the installed documentation.
(check-exn exn:fail? (lambda () (git 'help 'not-a-git-command)))
(check-exn exn:fail:contract? (lambda () (git-help "grep")))
tests/branch-merge.rkt
-70
View File
@@ -1,70 +0,0 @@
#lang racket/base
(require rackunit
racket/file
git)
(check-equal? (git 'version) "0.2.11")
(check-equal? (git-version) "0.2.11")
(define tmp (make-temporary-file "racket-git-branch-merge-test~a" 'directory))
(define (write-file path text)
(call-with-output-file path
#:exists 'truncate/replace
(lambda (out) (display text out))))
(dynamic-wind
void
(lambda ()
(parameterize ([current-directory tmp])
(git 'init)
(git 'config "user.name" "Racket Git Test")
(git 'config "user.email" "racket-git-test@example.invalid")
(write-file "README.md" "base\n")
(git 'add "README.md")
(define base (git 'commit "base"))
;; Reproduce the recovery case: create a commit while HEAD is detached,
;; give that commit a branch name, switch back, and merge it.
(git 'checkout base)
(check-false (git 'branch-current))
(write-file "README.md" "base\nrescued\n")
(git 'add "README.md")
(define rescued (git 'commit "detached README change"))
(check-false (git 'branch-current))
(check-equal? (git 'branch-create "rescue-readme") "rescue-readme")
(check-not-false (member "rescue-readme" (git 'branch)))
(git 'switch "master")
(check-equal? (git 'branch-current) "master")
(check-equal? (git 'merge "rescue-readme") rescued)
(check-equal? (git-head) rescued)
(check-equal? (file->string "README.md") "base\nrescued\n")
(check-false (git 'merge "rescue-readme"))
(git 'branch '-d "rescue-readme")
(check-false (member "rescue-readme" (git 'branch)))
;; Also exercise a real two-parent, conflict-free merge.
(git 'branch-create "feature")
(git 'switch "feature")
(write-file "feature.txt" "feature\n")
(git 'add "feature.txt")
(git 'commit "feature change")
(git 'switch "master")
(write-file "master.txt" "master\n")
(git 'add "master.txt")
(git 'commit "master change")
(define merge-id (git 'merge "feature"))
(check-equal? (string-length merge-id) 40)
(check-equal? (file->string "feature.txt") "feature\n")
(check-equal? (file->string "master.txt") "master\n")
(check-true (git-clean?))
(check-equal? (git 'branch-current) "master")
(check-true (>= (length (git 'log 10)) 5))
(git 'branch '-d "feature")))
(lambda ()
(delete-directory/files tmp)))
tests/credentials.rkt
-30
View File
@@ -1,30 +0,0 @@
#lang racket/base
(require rackunit
"../credentials.rkt")
;; Never touch the real racket-git preferences from the test suite.
(parameterize ([current-git-credentials-store 'racket-git-test]
[current-git-credentials-unlock-store 'racket-git-test-unlock])
(with-handlers ([exn:fail? (lambda (_) (void))])
(git-credentials-lock!))
(with-handlers ([exn:fail? (lambda (_) (void))])
(git-credentials-init! "test-password" #:unlock-for 60))
(unless (git-credentials-unlocked?)
(git-credentials-unlock! "test-password" #:for 60))
(check-true (git-credentials-unlocked?))
(git-credentials-set! "https://credentials-test.invalid"
"tester" "secret-token")
(check-equal?
(git-credentials-ref "https://credentials-test.invalid")
'("tester" . "secret-token"))
(check-equal?
(git-credentials-ref "https://credentials-test.invalid/a/b.git")
'("tester" . "secret-token"))
(git-credentials-remove! "https://credentials-test.invalid")
(check-false (git-credentials-ref "https://credentials-test.invalid"))
(git-credentials-lock!)
(check-false (git-credentials-unlocked?)))
tests/grep-reader.rkt
-32
View File
@@ -1,32 +0,0 @@
#lang racket/base
(require rackunit
"../main.rkt")
;; The Racket reader parses '-i as the complex number 0-1i. git-grep treats
;; that value as the Git -i option when it appears in option position.
(check-equal? '-i 0-1i)
;; Exercise the public argument parser indirectly in a temporary repository.
(require racket/file)
(define tmp (make-temporary-file "git-command-grep-reader~a" 'directory))
(dynamic-wind
void
(lambda ()
(parameterize ([current-directory tmp])
(git 'init)
(call-with-output-file "sample.txt"
#:exists 'truncate/replace
(lambda (out)
(displayln "Todo" out)
(displayln "other" out)))
(git 'add "sample.txt")
(define entries (git 'grep '-i "todo"))
(check-equal? (length entries) 1)
(check-equal? (git-grep-entry-path (car entries)) "sample.txt")
(check-equal? (git-grep-entry-line-number (car entries)) 1)
(check-equal? (git-grep-entry-line (car entries)) "Todo")))
(lambda ()
(delete-directory/files tmp #:must-exist? #f)))
tests/remote.rkt
-140
View File
@@ -1,140 +0,0 @@
#lang racket/base
(require rackunit
racket/file
git
libgit2)
(define tmp (make-temporary-file "racket-git-remote-test~a" 'directory))
(define origin (build-path tmp "origin.git"))
(define a (build-path tmp "a"))
(define b (build-path tmp "b"))
(define c (build-path tmp "c"))
(define (temporary-push-refs)
(filter (lambda (name)
(regexp-match? #rx"^refs/remotes/racket-git-push-" name))
(git_reference_list (git_repository_open (current-directory)))))
(define (configure!)
(git 'config "user.name" "Racket Git Test")
(git 'config "user.email" "racket-git-test@example.invalid"))
(dynamic-wind
void
(lambda ()
(git-init origin #:bare? #t)
(make-directory a)
(parameterize ([current-directory a])
(git 'init)
(configure!)
(call-with-output-file "value.txt"
#:exists 'truncate/replace
(lambda (out) (displayln "one" out)))
(git 'add "value.txt")
(git 'commit "one")
(git 'remote 'add "origin" (path->string origin))
(check-equal? (git 'remote) '("origin"))
(check-equal? (git 'remote 'get-url "origin") (path->string origin))
(define push-out (open-output-string))
(parameterize ([current-output-port push-out])
(git 'push))
;; A successful push must remain safe when the returned credentials,
;; callbacks and options become eligible for collection.
(collect-garbage)
(collect-garbage)
(collect-garbage)
(define push-text (get-output-string push-out))
(check-equal? (temporary-push-refs) '())
(check-true (regexp-match? #rx"\\[git\\] push origin/master" push-text))
(check-true (regexp-match? #rx"\\[git\\] push origin/master: done" push-text))
;; A real push reports transfer progress, but the FFI callback itself only
;; records state. A normal Racket thread performs the output.
(check-true (regexp-match? #rx"100%" push-text))
(define quiet-out (open-output-string))
(parameterize ([current-output-port quiet-out])
(git 'push #:quiet #t))
(check-equal? (get-output-string quiet-out) ""))
(git-clone (path->string origin) b)
(define clone-quiet-out (open-output-string))
(parameterize ([current-output-port clone-quiet-out])
(git-clone (path->string origin) c #:quiet #t))
(check-equal? (get-output-string clone-quiet-out) "")
(parameterize ([current-directory b])
(configure!)
(check-equal? (git-current-branch) "master")
(call-with-output-file "value.txt"
#:exists 'truncate/replace
(lambda (out) (displayln "two" out)))
(git 'add "value.txt")
(git 'commit "two")
(git 'push)
(check-equal? (temporary-push-refs) '())
(git 'tag "v2")
(git 'push-tag "v2")
(check-equal? (temporary-push-refs) '())
(define push-tag-quiet-out (open-output-string))
(parameterize ([current-output-port push-tag-quiet-out])
(git 'push-tag "v2" #:quiet #t))
(check-equal? (get-output-string push-tag-quiet-out) ""))
(parameterize ([current-directory a])
(check-equal? (file->string "value.txt") "one\n")
(check-equal? (string-length (git 'pull)) 40)
(check-equal? (file->string "value.txt") "two\n")
(check-true (git-clean?))
(git 'fetch)
(check-equal? (git 'tag) '("v2"))
(define fetch-quiet-out (open-output-string))
(parameterize ([current-output-port fetch-quiet-out])
(git 'fetch #:quiet #t))
(check-equal? (get-output-string fetch-quiet-out) "")
(define pull-quiet-out (open-output-string))
(check-false
(parameterize ([current-output-port pull-quiet-out])
(git 'pull #:quiet #t)))
(check-equal? (get-output-string pull-quiet-out) "")
(call-with-output-file "local.txt"
#:exists 'truncate/replace
(lambda (out) (displayln "local" out)))
(git 'add "local.txt")
(git 'commit "local change"))
(parameterize ([current-directory b])
(call-with-output-file "remote.txt"
#:exists 'truncate/replace
(lambda (out) (displayln "remote" out)))
(git 'add "remote.txt")
(git 'commit "remote change")
(git 'push))
(parameterize ([current-directory a])
(define before (git-head))
(check-exn #rx"non-fast-forward"
(lambda () (git 'pull)))
(check-equal? (git-head) before)
(check-true (file-exists? "local.txt"))
(check-false (file-exists? "remote.txt"))))
(lambda ()
(delete-directory/files tmp)))
;; HTTPS push without configured credentials must fail before entering libgit2.
(let ([tmp2 (make-temporary-file "racket-git-https-test~a" 'directory)])
(dynamic-wind
void
(lambda ()
(parameterize ([current-directory tmp2])
(git 'init)
(configure!)
(call-with-output-file "x.txt" #:exists 'truncate/replace
(lambda (out) (displayln "x" out)))
(git 'add "x.txt")
(git 'commit "x")
(git 'remote 'add "origin" "https://example.invalid/private/repo.git")
(check-exn #rx"no HTTPS credentials are stored"
(lambda () (git 'push)))))
(lambda () (delete-directory/files tmp2))))
tests/stress-commit.rkt
-18
View File
@@ -1,18 +0,0 @@
#lang racket/base
(require racket/file rackunit git)
(define tmp (make-temporary-file "racket-git-stress~a" 'directory))
(dynamic-wind
void
(lambda ()
(parameterize ([current-directory tmp])
(git 'init)
(git 'config "user.name" "Stress Test")
(git 'config "user.email" "stress@example.invalid")
(for ([i (in-range 50)])
(call-with-output-file "counter.txt" #:exists 'truncate/replace
(lambda (out) (fprintf out "~a\n" i)))
(git 'add "counter.txt")
(define oid (git 'commit (format "commit ~a" i)))
(check-equal? (string-length oid) 40))
(check-equal? (length (git 'log 100)) 50)))
(lambda () (delete-directory/files tmp)))