├── .gitignore ├── .travis.yml ├── LICENSE.txt ├── README.md ├── git-api-test.asd ├── git-api.asd ├── src ├── object.lisp ├── pack.lisp ├── package.lisp ├── plumbing │ ├── details │ │ ├── attributes.lisp │ │ └── filemasks.lisp │ ├── helpers.lisp │ ├── info.lisp │ ├── manip.lisp │ └── sync.lisp ├── repo.lisp ├── utils.lisp └── zlib │ ├── cffi.lisp │ └── wrapper.lisp └── t ├── attributes-test.lisp ├── base.lisp ├── coverage.lisp ├── data ├── binary.dat ├── corrupted_pack0.idx ├── corrupted_pack0.pack ├── corrupted_pack1.idx ├── corrupted_pack1.pack ├── corrupted_pack2.idx ├── corrupted_pack2.pack ├── example-objects │ ├── 52 │ │ ├── 00e67faf9a9a39b916f7779fe98bcaa47eda0c │ │ └── 4acfffa760fd0b8c1de7cf001f8dd348b399d8 │ ├── big-git-object.dat │ └── small-git-object.dat ├── example-repo-extracted │ ├── 96057f0a67f7ad0d334820689410fd65a25e47c4.contents │ ├── 9eeff76aaa278e9253b0106dfab6b8ab2619d695.contents │ ├── cb96e53d08dbfc0d358c5f312029aecaf584a390.contents │ └── dee95d63ff98bc1b1ef6e26ae7d83eb40d653d3e.contents ├── example-repo │ ├── COMMIT_EDITMSG │ ├── HEAD │ ├── config │ ├── description │ ├── hooks │ │ ├── applypatch-msg.sample │ │ ├── commit-msg.sample │ │ ├── post-update.sample │ │ ├── pre-applypatch.sample │ │ ├── pre-commit.sample │ │ ├── pre-push.sample │ │ ├── pre-rebase.sample │ │ ├── prepare-commit-msg.sample │ │ └── update.sample │ ├── index │ ├── info │ │ ├── exclude │ │ └── refs │ ├── logs │ │ ├── HEAD │ │ └── refs │ │ │ └── heads │ │ │ └── master │ ├── objects │ │ ├── info │ │ │ └── packs │ │ └── pack │ │ │ ├── pack-559f5160ab63a074f365f538d209164b5d8a715a.idx │ │ │ └── pack-559f5160ab63a074f365f538d209164b5d8a715a.pack │ ├── packed-refs │ └── refs │ │ ├── heads │ │ └── .empty │ │ └── tags │ │ └── .empty ├── git-commit.compressed ├── git-commit.uncompressed ├── readoneline.txt ├── test.idx ├── test.pack └── test_idx.sexp ├── filemasks-test.lisp ├── object-test.lisp ├── pack-test.lisp ├── repo-test.lisp ├── utils-test.lisp └── wrapper-test.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.xfasl 3 | *.dx32fsl 4 | *.dx64fsl 5 | *.lx32fsl 6 | *.lx64fsl 7 | *.x86f 8 | *~ 9 | .#* 10 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: common-lisp 2 | sudo: required 3 | 4 | env: 5 | matrix: 6 | - LISP=sbcl 7 | - LISP=ccl 8 | - LISP=ccl32 9 | 10 | os: 11 | - linux 12 | 13 | install: 14 | # Install cl-travis 15 | - curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | bash 16 | 17 | script: 18 | - cl -l prove -e '(or (prove:run :git-api-test) (uiop:quit -1))' 19 | 20 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Alexey Veretennikov. All rights reserved. 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions 5 | are met: 6 | 7 | * Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above 11 | copyright notice, this list of conditions and the following 12 | disclaimer in the documentation and/or other materials 13 | provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 16 | OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 18 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 19 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 21 | GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 22 | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 23 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 24 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 25 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Give Up GitHub 2 | 3 | This project has given up GitHub. ([See Software Freedom Conservancy's *Give Up GitHub* site for details](https://GiveUpGitHub.org).) 4 | 5 | You can now find this project at [https://codeberg.org/fourier/git-api](https://codeberg.org/fourier/git-api) instead. 6 | 7 | Any use of this project's code by GitHub Copilot, past or present, is done without our permission. We do not consent to GitHub's use of this project's code in Copilot. 8 | 9 | Join us; you can [give up GitHub](https://GiveUpGitHub.org) too! 10 | 11 | ![Logo of the GiveUpGitHub campaign](https://sfconservancy.org/img/GiveUpGitHub.png) 12 | -------------------------------------------------------------------------------- /git-api-test.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of git-api project. 3 | Copyright (c) 2016 Alexey Veretennikov (alexey.veretennikov@gmail.com) 4 | 5 | Test package. 6 | Usage: 7 | (ql:quickload :git-api-test) 8 | (asdf/operate:test-system :git-api) 9 | 10 | In order to perform code coverage with these tests (currenty supported 11 | only on LispWorks 7), run the following: 12 | (asdf/operate:operate 'git-api-test-asd:coverage-op :git-api-test) 13 | |# 14 | 15 | 16 | 17 | (in-package :cl-user) 18 | (defpackage git-api-test-asd 19 | (:use :cl :asdf) 20 | (:export coverage-op)) 21 | 22 | (in-package :git-api-test-asd) 23 | 24 | 25 | (defclass coverage-op (selfward-operation) 26 | ((selfward-operation :initform 'load-op :allocation :class)) 27 | (:documentation "Test coverage operation")) 28 | 29 | 30 | (defsystem git-api-test 31 | :author "Alexey Veretennikov" 32 | :license "BSD" 33 | :depends-on (:git-api 34 | :cl-fad 35 | :flexi-streams 36 | :nibbles 37 | :split-sequence 38 | :prove) 39 | :components ((:module "t" 40 | :components 41 | ((:file "base") 42 | (:file "coverage") 43 | (:test-file "utils-test") 44 | (:test-file "pack-test") 45 | (:test-file "wrapper-test") 46 | (:test-file "object-test") 47 | (:test-file "repo-test") 48 | (:test-file "filemasks-test") 49 | (:test-file "attributes-test")))) 50 | :description "Test system for git-api" 51 | 52 | :defsystem-depends-on (:prove-asdf) 53 | :perform (test-op :after (op c) 54 | (funcall (intern #.(string :run-test-system) :prove-asdf) c) 55 | (asdf:clear-system c)) 56 | :perform (coverage-op (op c) 57 | (funcall (intern #.(string :run-tests-with-coverage) :git-api.test.coverage)) 58 | (asdf:clear-system c))) 59 | 60 | 61 | -------------------------------------------------------------------------------- /git-api.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of git-api project. 3 | Copyright (c) 2016 Alexey Veretennikov (alexey.veretennikov@gmail.com) 4 | |# 5 | 6 | #| 7 | Library for accessing git repository 8 | 9 | Author: Alexey Veretennikov (alexey.veretennikov@gmail.com) 10 | |# 11 | 12 | (in-package :cl-user) 13 | (defpackage git-api-asd 14 | (:use :cl :asdf)) 15 | (in-package :git-api-asd) 16 | 17 | (defsystem #:git-api 18 | :version "0.1" 19 | :author "Alexey Veretennikov" 20 | :license "BSD" ;; https://opensource.org/licenses/bsd-license.php 21 | :depends-on (#:alexandria ; general utilities - Public domain 22 | #:cl-fad ; files manipulation - BSD 23 | #:cl-ppcre ; portable regular expressions - BSD 24 | #:babel ; bytes to string - MIT 25 | #:zlib ; zlib to deal with git objects - LLGPL 26 | #:split-sequence ; general split - public domain 27 | #:nibbles ; to parse binary data - BSD 28 | #:flexi-streams ; to create in-memory streams - BSD 29 | #:ironclad ; sha1 checksum - X11/MIT-like license 30 | #:cffi ; to access dlls (libz) - MIT 31 | #:static-vectors) ; to use common arrays between C and Lisp code - MIT 32 | :components ((:module "src" 33 | :components 34 | ((:file "utils") 35 | (:module "zlib" 36 | :depends-on ("utils") 37 | :serial t 38 | :components 39 | ((:file "cffi") 40 | (:file "wrapper"))) 41 | (:file "pack" :depends-on ("utils" "zlib")) 42 | (:file "object" :depends-on ("utils" "zlib")) 43 | (:file "repo" :depends-on ("utils" "pack" "object")) 44 | (:module "plumbing" 45 | :depends-on ("repo") 46 | :serial t 47 | :components 48 | ((:module "details" 49 | :serial t 50 | :components 51 | ((:file "filemasks") 52 | (:file "attributes"))) 53 | (:file "helpers") 54 | (:file "info") 55 | (:file "manip") 56 | (:file "sync"))) 57 | (:file "package")))) 58 | :description "Library for accessing git repository" 59 | :long-description 60 | #.(with-open-file (stream (merge-pathnames 61 | #p"README.md" 62 | (or *load-pathname* *compile-file-pathname*)) 63 | :if-does-not-exist nil 64 | :direction :input) 65 | (when stream 66 | (let ((seq (make-array (file-length stream) 67 | :element-type 'character 68 | :fill-pointer t))) 69 | (setf (fill-pointer seq) (read-sequence seq stream)) 70 | seq))) 71 | :in-order-to ((test-op (test-op git-api-test)))) 72 | -------------------------------------------------------------------------------- /src/object.lisp: -------------------------------------------------------------------------------- 1 | ;;;; object.lisp 2 | (defpackage #:git-api.object 3 | (:use #:cl #:alexandria #:git-api.utils) 4 | (:export 5 | ;; object base 6 | object-hash 7 | ;; commit object 8 | commit 9 | commit-tree 10 | commit-author 11 | commit-committer 12 | commit-comment 13 | commit-parents 14 | ;; blob 15 | blob 16 | blob-content 17 | ;; tree entry readers 18 | tree-entry-name tree-entry-mode tree-entry-hash 19 | ;; tree object 20 | tree 21 | tree-entries 22 | ;; tag object 23 | tag 24 | tag-object 25 | tag-type 26 | tag-tagger 27 | tag-comment 28 | ;; exported functions 29 | parse-git-file 30 | parse-git-object 31 | )) 32 | 33 | 34 | (in-package #:git-api.object) 35 | 36 | 37 | ;;---------------------------------------------------------------------------- 38 | ;; Git Object class 39 | ;;---------------------------------------------------------------------------- 40 | (defclass git-object () 41 | ((hash :initarg :hash :reader object-hash :type '(vector unsigned-byte 8) :initform nil 42 | :documentation "Every git object has a SHA1-hash")) 43 | (:documentation "Base class for Git objects")) 44 | 45 | 46 | ;;---------------------------------------------------------------------------- 47 | ;; Git Commit class 48 | ;;---------------------------------------------------------------------------- 49 | (defclass commit (git-object) 50 | ((tree :initarg :tree :reader commit-tree :initform "" :type simple-string 51 | :documentation "SHA1-hash string of the associated tree object") 52 | (author :initarg :author :reader commit-author :initform "" :type simple-string 53 | :documentation "String representing commit author field") 54 | (committer :initarg :committer :reader commit-committer :initform "" :type simple-string 55 | :documentation "String representing committer field") 56 | (comment :initarg :comment :reader commit-comment :initform "" :type string 57 | :documentation "Commit comment. Empty string if not comment") 58 | (parents :initarg :parents :reader commit-parents :initform nil :type list 59 | :documentation "A list of sha1 hashes of parents commits, even if only one parent")) 60 | (:documentation "Git Commit object")) 61 | 62 | (defmethod print-object ((self commit) stream) 63 | "Print to STREAM the commit contents" 64 | (with-slots (hash tree author committer comment parents) self 65 | (format stream "commit: ~a~%" hash) 66 | (format stream "tree ~a~%" tree) 67 | (format stream "author ~a~%" author) 68 | (format stream "committer ~a~%" committer) 69 | (format stream "parents ~{~a~^, ~}~%" parents) 70 | (format stream "comment~%~a" comment))) 71 | 72 | ;;---------------------------------------------------------------------------- 73 | ;; Git Blob class 74 | ;;---------------------------------------------------------------------------- 75 | (defclass blob (git-object) 76 | ((content :initarg :content :reader blob-content :initform nil :type '(vector unsigned-byte 8) 77 | :documentation "The blob object contents as a vector of unsigned bytes")) 78 | (:documentation "Git Blob object")) 79 | 80 | (defmethod print-object ((self blob) stream) 81 | "Print to STREAM the size of the blob object" 82 | (with-slots (content) self 83 | (format stream "blob of size ~d bytes~%" (length content)))) 84 | 85 | 86 | 87 | ;;---------------------------------------------------------------------------- 88 | ;; Git Tree class 89 | ;;---------------------------------------------------------------------------- 90 | (defstruct tree-entry 91 | "A struct representing particular tree entry: NAME, MODE, SHA1-hash" 92 | name mode hash) 93 | 94 | (defmethod print-object ((self tree-entry) stream) 95 | "Print to STREAM contents of the tree entry in format: MODE NAME HASH" 96 | (format stream "~a ~a ~a" 97 | (tree-entry-mode self) 98 | (tree-entry-name self) 99 | (tree-entry-hash self))) 100 | 101 | 102 | (defclass tree (git-object) 103 | ((entries :initarg :entries :reader tree-entries :initform nil :type (or list nil) 104 | :documentation "A list of tree entries (instances of TREE-ENTRY struct)")) 105 | (:documentation "Git Tree object")) 106 | 107 | 108 | (defmethod print-object ((self tree) stream) 109 | "Print to STREAM the every tree entry in the tree object" 110 | (with-slots (entries) self 111 | (mapc (lambda (e) 112 | (format stream "~a~%" e)) 113 | entries))) 114 | 115 | 116 | ;;---------------------------------------------------------------------------- 117 | ;; Git Tag class 118 | ;;---------------------------------------------------------------------------- 119 | (todo "review class `tag' and comment it") 120 | (defclass tag (git-object) 121 | ((object :initarg :tree :reader tag-object :initform "") 122 | (type :initarg :author :reader tag-type :initform "") 123 | (tagger :initarg :committer :reader tag-tagger :initform "") 124 | (comment :initarg :comment :reader tag-comment :initform "") 125 | (tag :initarg :parents :reader tag :initform nil)) 126 | (:documentation "Git Tag object")) 127 | 128 | (defmethod print-object ((self tag) stream) 129 | (with-slots (object type tagger tag comment) self 130 | (format stream "object ~a~%" object) 131 | (format stream "type ~a~%" type) 132 | (format stream "tagger ~a~%" tagger) 133 | (format stream "tag ~a~%" tag) 134 | (format stream "comment~%~a" comment))) 135 | 136 | 137 | ;;---------------------------------------------------------------------------- 138 | ;; Exported functions 139 | ;;---------------------------------------------------------------------------- 140 | (defun parse-git-file (filename) 141 | "Parse the git file (inside .git/objects/ directory) pointed by the 142 | FILENAME. 143 | Returns the parsed git object - COMMIT, TAG, TREE or BLOB" 144 | (declare (optimize speed)) 145 | (let* ((data 146 | (git-api.zlib.wrapper:uncompress-git-file filename)) 147 | (content-start (position 0 data)) 148 | (size-start (position 32 data)) 149 | (type (babel:octets-to-string data :start 0 :end size-start :encoding :utf-8)) 150 | (len (babel:octets-to-string data :start (1+ size-start) :end content-start :encoding :utf-8)) 151 | ;; guess the hash. hash is the last 41 (40 hash + 1 directory separator) 152 | ;; characters of the filename, if the filename is in git repository 153 | ;; and not renamed git object 154 | (name (if (pathnamep filename) (namestring filename) filename)) 155 | (hash-filename (subseq name (- (length name) 41)))) 156 | (parse-git-object (intern (string-upcase type) "KEYWORD") 157 | data 158 | (remove #\/ hash-filename) ;; remove dir separator 159 | :start (1+ content-start) 160 | :size (parse-integer len)))) 161 | 162 | (defgeneric parse-git-object (type data hash &key start size) 163 | (:documentation "Parses the git object in DATA byte array starting from position START 164 | of size SIZE. 165 | TYPE is one of keywords: :COMMIT, :TAG, :TREE or :BLOB. 166 | HASH is the 40-characters hex SHA1 string identifying the object. 167 | Returns the parsed git object - COMMIT, TAG, TREE or BLOB")) 168 | 169 | 170 | ;;---------------------------------------------------------------------------- 171 | ;; Implementation 172 | ;;---------------------------------------------------------------------------- 173 | (defun parse-text-git-data (data start size) 174 | "Parses the data for text git objects (commit,tag) 175 | and returns a PAIR: 176 | (car PAIR) = list of lines before the comment 177 | (cdr PAIR) = comment" 178 | (declare (optimize (speed 3) (safety 0) (debug 0))) 179 | (declare (type fixnum start size)) 180 | (let* ((text (babel:octets-to-string data 181 | :start start 182 | :end (the fixnum (+ start size)) 183 | :errorp nil 184 | :encoding :utf-8)) 185 | (text-length (the fixnum (length text))) 186 | ;; 3 cases: 187 | ;; 1. 2 consecutive newlines in the middle of the text 188 | ;; 2. consecutive newlines at the end of the text - newline-position = (length - 2) 189 | ;; 3. no consecutive newlines - newline-position = length 190 | (newline-position (the fixnum (find-consecutive-newlines text))) 191 | (header (the string (subseq text 0 newline-position))) 192 | (comment 193 | (if (>= newline-position (- text-length 2)) 194 | "" 195 | (subseq text (+ 2 newline-position))))) 196 | (declare (type string text comment) 197 | (type simple-string header) 198 | (type fixnum text-length newline-position)) 199 | (cons (split-sequence:split-sequence #\newline header) 200 | comment))) 201 | 202 | 203 | (defmethod parse-git-object ((obj (eql :blob)) data hash &key start size) 204 | "Parses the git object of type BLOB" 205 | (let ((blob (make-instance 'blob :hash hash :content (subseq data start (+ start size))))) 206 | blob)) 207 | 208 | 209 | (defun find-consecutive-newlines (str &key (first 0) (last (length str))) 210 | "Find 2 consecutive newlines in the string STR. 211 | Returns the index of the first element found or size of STR if 212 | nothing found" 213 | (declare (type simple-string str) 214 | (type fixnum first last)) 215 | (declare (optimize (speed 3) (safety 0) (debug 0))) 216 | (if (/= first last) 217 | (loop with next fixnum = (1+ first) 218 | while (/= next last) 219 | when (char= (the character (char str first)) 220 | (the character (char str next)) #\newline) 221 | return first 222 | do 223 | (incf first) 224 | (incf next) 225 | finally (return last)) 226 | last)) 227 | 228 | 229 | (defmethod parse-git-object ((obj (eql :commit)) data hash &key start size) 230 | "Parses the git object of type COMMIT" 231 | (let* ((parsed-data (parse-text-git-data data start size)) 232 | (commit (make-instance 'commit :hash hash :comment (cdr parsed-data)))) 233 | (with-slots (tree author committer parents) commit 234 | (dolist (line (car parsed-data)) 235 | (let* ((space-pos (position #\Space line)) 236 | (value (subseq line (1+ space-pos)))) 237 | (switch (line :test (lambda (x y) (string= x y :end1 space-pos))) 238 | ("tree" (setf tree value)) 239 | ("author" (setf author value)) 240 | ("committer" (setf committer value)) 241 | ("parent" (push value parents)))))) 242 | commit)) 243 | 244 | 245 | 246 | (defmethod parse-git-object ((obj (eql :tag)) data hash &key start size) 247 | "Parses the git object of type TAG" 248 | (let* ((parsed-data (parse-text-git-data data start size)) 249 | (self (make-instance 'tag :hash hash :comment (cdr parsed-data)))) 250 | (dolist (line (car parsed-data)) 251 | (let* ((space-pos (position #\Space line)) 252 | (key (subseq line 0 space-pos)) 253 | (value (subseq line (1+ space-pos)))) 254 | (setf (slot-value self (intern (string-upcase key) :git-api.object)) value))) 255 | self)) 256 | 257 | 258 | (defun parse-tree-entry (data start) 259 | "Returns values: entry and position after the entry" 260 | (let* ((separator (position 0 data :start start)) ; 0-separator separating header and hash-code 261 | (header (split-sequence:split-sequence #\Space ; split header into mode and filename 262 | (babel:octets-to-string data :start start :end separator))) 263 | ;; finally extract 20 bytes of hash 264 | (hash (subseq data (1+ separator) (+ separator 21)))) 265 | ;; return the cons entry + next position to parse 266 | (cons (make-tree-entry :mode (car header) :name (cadr header) 267 | :hash 268 | ;; need to downcase to be compatible with the representation 269 | ;; in the file system 270 | (sha1-to-hex hash)) 271 | (+ 21 separator)))) 272 | 273 | (defmethod parse-git-object ((obj (eql :tree)) data hash &key start size) 274 | "Parses the git object of type TREE" 275 | ;; format: 276 | ;; [mode] [file/folder name]\0[SHA-1 of referencing blob or tree] 277 | ;; mode is a string, file/folder name is a string, 278 | ;; SHA-1 code is 20 bytes 279 | ;; parse in the loop until the end reached 280 | (loop with self = (make-instance 'tree :hash hash) 281 | and next-start = start 282 | while (< next-start (+ start size)) 283 | do 284 | (let ((parsed (parse-tree-entry data next-start))) 285 | ;; push the value 286 | (push (car parsed) (slot-value self 'entries)) 287 | ;; ... and increase the position 288 | (setf next-start (cdr parsed))) 289 | finally 290 | ;; finally reverse the parsed list 291 | (setf (slot-value self 'entries) (nreverse (slot-value self 'entries))) 292 | (return self))) 293 | 294 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of git-api project. 3 | 4 | (C) COPYRIGHT Alexey Veretennikov, 2019 5 | |# 6 | 7 | (in-package :cl-user) 8 | (defpackage git-api 9 | (:use :git-api.repo :git-api.object) 10 | (:export 11 | ;; repo 12 | make-git-repo 13 | git-repo-close 14 | rev-parse 15 | get-commit 16 | get-object-by-hash 17 | cat-file 18 | ;; object base 19 | git-object 20 | object-hash 21 | ;; commit object 22 | commit 23 | commit-tree 24 | commit-author 25 | commit-committer 26 | commit-comment 27 | commit-parents 28 | ;; blob 29 | blob 30 | blob-content 31 | ;; tree entry readers 32 | tree-entry-name tree-entry-mode tree-entry-hash 33 | ;; tree object 34 | tree 35 | tree-entries 36 | ;; tree-entry struct 37 | tree-entry 38 | tree-entry-mode 39 | tree-entry-name 40 | tree-entry-hash 41 | ;; tag object 42 | tag 43 | tag-object 44 | tag-type 45 | tag-tagger 46 | tag-comment)) 47 | 48 | 49 | -------------------------------------------------------------------------------- /src/plumbing/details/attributes.lisp: -------------------------------------------------------------------------------- 1 | ;;;; attributes.lisp 2 | (defpackage #:git-api.plumbing.helpers.details.attributes 3 | (:use #:cl #:alexandria #:git-api.utils) 4 | (:export 5 | parse-attribute-line 6 | parse-attribute-macro 7 | )) 8 | 9 | (in-package #:git-api.plumbing.helpers.details.attributes) 10 | 11 | 12 | ;; imports 13 | ;;(from git-api.repo import git-repo) 14 | ;;(from babel import octets-to-string) 15 | 16 | ;;---------------------------------------------------------------------------- 17 | ;; Helper functions for git attributes parsing/processing 18 | ;; Read https://www.kernel.org/pub/software/scm/git/docs/gitattributes.html 19 | ;; for more some information 20 | ;;---------------------------------------------------------------------------- 21 | 22 | (defun parse-collected-attributes (attrs) 23 | "Parse collected attributes. 24 | Example: giving the attrs as an array ('-diff' '-merge' '-text') 25 | returns alist (('diff' . :unset) ('merge' . :unset) ('text' . unset))" 26 | (flet ((parse-attr (attr) 27 | (cond ((eql #\- (char attr 0)) 28 | (cons (subseq attr 1) :unset)) 29 | ((eql #\! (char attr 0)) 30 | (cons (subseq attr 1) :unspecified)) 31 | ((find #\= attr) 32 | (let ((kv (split-sequence:split-sequence #\= attr))) 33 | (cons (first kv) (second kv)))) 34 | (t (cons attr :set))))) 35 | (mapcar (lambda (attr) 36 | (parse-attr attr)) 37 | attrs))) 38 | 39 | 40 | (defun parse-attribute-line (line) 41 | "For a given string line LINE produces a pair: 42 | (PATTERN LIST-OF-ATTRIBUTES) 43 | where the PATTERN is the file pattern, 44 | LIST-OF-ATTRIBUTES is a LIST-OF-ATTRIBUTES is a list of pairs: 45 | (ATTRIBUTE-NAME . VALUE) 46 | Here VALUE could be either :set, :unset, :unspecified or text value of the attribute. 47 | If the attribute value is set as 'unspecified' then this attribute will 48 | be used to override attributes on other levers as unspecified. 49 | Example: 50 | (parse-attribute-line \"abc -foo -bar\") will return 51 | (\"abc\" (\"foo\" . :unset) (\"bar\" . :unset))" 52 | (let ((parsed 53 | (remove-if (lambda (x) (= (length x) 0)) (ppcre:split "\\s" line)))) 54 | (cons (car parsed) 55 | (parse-collected-attributes (cdr parsed))))) 56 | 57 | 58 | (defun parse-attribute-macro (line) 59 | "Parses line containing Git attribute macros. Returns NIL if the line is not 60 | a Git attribute macro. 61 | Example: 62 | (parse-attribute-macro \"[attr]binary -diff -merge -text\") will return a list: 63 | (\"binary\" (\"diff\" . :unset) (\"merge\" . :unset) (\"text\" . :unset))" 64 | (let ((parsed 65 | (remove-if (lambda (x) (= (length x) 0)) (ppcre:split "\\s" line)))) 66 | (when (starts-with-subseq "[attr]" (car parsed)) 67 | (cons (subseq (car parsed) 6) 68 | (parse-collected-attributes (cdr parsed)))))) 69 | 70 | -------------------------------------------------------------------------------- /src/plumbing/details/filemasks.lisp: -------------------------------------------------------------------------------- 1 | ;;;; filemasks.lisp 2 | (defpackage #:git-api.plumbing.helpers.details.filemasks 3 | (:use #:cl #:alexandria #:git-api.utils) 4 | (:export 5 | wildcard-to-regex 6 | translate)) 7 | 8 | (in-package #:git-api.plumbing.helpers.details.filemasks) 9 | 10 | 11 | 12 | (defun wildcard-to-regex (pattern &key (case-sensitive-p t) (beginning-of-string t) (end-of-string t)) 13 | "Convert file wildcards to regular expressions. By default the regular 14 | expression is case sensitive. This is regulated by keyword argument 15 | CASE-SENSITIVE-P. 16 | Parameters BEGINNING-OF-STRING and END-OF-STRING identify whether the beginning of the string (^) 17 | or end of string ($) marker should be present. 18 | Supported patters: 19 | 20 | * - everything 21 | ? - any character 22 | [range] - any character in range 23 | [!range] - any character not in range 24 | 25 | Example: 26 | => (wildcard-to-regex \"Photo*.jpg\") 27 | \"^Photo.*\\\\.jpg$\" 28 | => (wildcard-to-regex \"Photo*.jpg\" :case-sensitive-p nil) 29 | \"(?i)^Photo.*\\\\.jpg$\"" 30 | (let ((regex 31 | (loop for i below (length pattern) 32 | for c = (char pattern i) 33 | if (char= c #\*) ; process * mask 34 | collect ".*" into result 35 | else if (char= c #\?) ; process ? 36 | collect "." into result 37 | else if (char= c #\[) ; range found 38 | collect ;;(extract-range i) 39 | (if-let (close-pos (position #\] pattern :start i)) ;; find closing ] 40 | ;; found, replace \ with \\ 41 | (let ((res (ppcre:regex-replace-all "\\" (subseq pattern (1+ i ) close-pos) "\\\\" ))) 42 | (setf i close-pos) ; increase current position to the end of range 43 | (format nil "[~a]" 44 | (cond ((char= (char res 0) #\!) 45 | (concatenate 'string "^" (subseq res 1))) 46 | ((char= (char res 0) #\^) 47 | (concatenate 'string "\\" res)) 48 | (t res)))) 49 | ;; no closing range character found, assuming special 50 | "\\[") 51 | into result 52 | else ; finally just append rest (quoting specials of course) 53 | collect (ppcre:quote-meta-chars (string c)) into result 54 | end 55 | finally 56 | (return (apply #'concatenate 'string result))))) 57 | (concatenate 'string 58 | (unless case-sensitive-p "(?i)") 59 | (when beginning-of-string "^") 60 | regex 61 | (when end-of-string "$")))) 62 | 63 | 64 | 65 | -------------------------------------------------------------------------------- /src/plumbing/helpers.lisp: -------------------------------------------------------------------------------- 1 | ;;;; object.lisp 2 | (defpackage #:git-api.plumbing.helpers 3 | (:use #:cl #:alexandria #:git-api.utils #:git-api.repo) 4 | (:export 5 | git-check-attr 6 | git-check-ignore 7 | git-check-mailmap 8 | git-check-ref-format 9 | git-column 10 | git-credential 11 | git-credential-cache 12 | git-credential-store 13 | git-fmt-merge-msg 14 | git-interpret-trailers 15 | git-mailinfo 16 | git-mailsplit 17 | git-merge-one-file 18 | git-patch-id 19 | git-sh-i18n 20 | git-sh-setup 21 | git-stripspace 22 | )) 23 | 24 | (in-package #:git-api.plumbing.helpers) 25 | 26 | 27 | ;; imports 28 | (from git-api.repo import git-repo) 29 | ;;(from babel import octets-to-string) 30 | 31 | ;;---------------------------------------------------------------------------- 32 | ;; helpers used by other functions 33 | ;; Read https://www.kernel.org/pub/software/scm/git/docs/git.html 34 | ;; for more information 35 | ;;---------------------------------------------------------------------------- 36 | 37 | 38 | (defun parse-attribute-line (line) 39 | "For a given string line LINE produces a pair: 40 | (PATTERN . LIST-OF-ATTRIBUTES) 41 | where the PATTERN is the file pattern, 42 | LIST-OF-ATTRIBUTES is a LIST-OF-ATTRIBUTES is a list of pairs: 43 | (ATTRIBUTE-NAME . VALUE) 44 | Here VALUE could be either :set, :unset or text value of the attribute. 45 | If the attribute value is set as 'unspecified' then this attribute will 46 | be omitted from the list" 47 | nil) 48 | 49 | (defmethod git-check-attr ((self git-repo) pathname1 &rest pathnames) 50 | "Get gitattributes information for given paths. 51 | 52 | Returs a list of pairs:(PATHNAME . LIST-OF-ATTRIBUTES) 53 | Where the LIST-OF-ATTRIBUTES is a list of pairs: 54 | (ATTRIBUTE-NAME . VALUE) 55 | Here VALUE could be either :set, :unset or text value of the attribute. 56 | If the attribute value is set as 'unspecified' then this attribute will 57 | be omitted from the list" 58 | ;; read https://www.kernel.org/pub/software/scm/git/docs/git-check-attr.html 59 | ;; for details 60 | 61 | 62 | ) 63 | 64 | 65 | (defun pattern-resolve (pathname pattern) 66 | "Resolves a PATHNAME against the PATTERN 67 | Returns PATHNAME if PATHNAME matches the PATTERN and NIL otherwise." 68 | (todo "Implement this function: pattern-resolve") 69 | ;; Pattern format is taken from gitignore manual: 70 | ;; https://www.kernel.org/pub/software/scm/git/docs/gitignore.html 71 | ;; 72 | ;; * A blank line matches no files, so it can serve as a separator for readability. 73 | ;; * A line starting with # serves as a comment. Put a backslash ("\") in front 74 | ;; of the first hash for patterns that begin with a hash. 75 | ;; * Trailing spaces are ignored unless they are quoted with backslash ("\"). 76 | ;; * An optional prefix "!" which negates the pattern; any matching file 77 | ;; excluded by a previous pattern will become included again. It is not 78 | ;; possible to re-include a file if a parent directory of that file is 79 | ;; excluded. Git doesn't list excluded directories for performance reasons, 80 | ;; so any patterns on contained files have no effect, no matter where they 81 | ;; are defined. Put a backslash ("\") in front of the first "!" for patterns 82 | ;; that begin with a literal "!", for example, "\!important!.txt". 83 | ;; * If the pattern ends with a slash, it is removed for the purpose of the 84 | ;; following description, but it would only find a match with a directory. 85 | ;; In other words, foo/ will match a directory foo and paths underneath it, 86 | ;; but will not match a regular file or a symbolic link foo (this is 87 | ;; consistent with the way how pathspec works in general in Git). 88 | ;; * If the pattern does not contain a slash /, Git treats it as a shell 89 | ;; glob pattern and checks for a match against the pathname relative 90 | ;; to the location of the .gitignore file (relative to the toplevel of 91 | ;; the work tree if not from a .gitignore file). 92 | ;; * Otherwise, Git treats the pattern as a shell glob suitable for 93 | ;; consumption by fnmatch(3) with the FNM_PATHNAME flag: wildcards in the 94 | ;; pattern will not match a / in the pathname. For example, 95 | ;; "Documentation/*.html" matches "Documentation/git.html" but not 96 | ;; "Documentation/ppc/ppc.html" or "tools/perf/Documentation/perf.html". 97 | ;; * A leading slash matches the beginning of the pathname. For example, 98 | ;; "/*.c" matches "cat-file.c" but not "mozilla-sha1/sha1.c". 99 | ;; 100 | ;; Two consecutive asterisks ("**") in patterns matched against full 101 | ;; pathname may have special meaning: 102 | ;; * A leading "**" followed by a slash means match in all directories. 103 | ;; For example, "**/foo" matches file or directory "foo" anywhere, 104 | ;; the same as pattern "foo". "**/foo/bar" matches file or directory 105 | ;; "bar" anywhere that is directly under directory "foo". 106 | ;; * A trailing "/**" matches everything inside. For example, "abc/**" 107 | ;; matches all files inside directory "abc", relative to the location 108 | ;; of the .gitignore file, with infinite depth. 109 | ;; * A slash followed by two consecutive asterisks then a slash matches 110 | ;; zero or more directories. For example, "a/**/b" matches "a/b", 111 | ;; "a/x/b", "a/x/y/b" and so on. 112 | ;; * Other consecutive asterisks are considered invalid. 113 | pathname) 114 | 115 | (defmethod git-check-ignore ((self git-repo)) 116 | "Debug gitignore / exclude files.") 117 | 118 | (defmethod git-check-mailmap ((self git-repo)) 119 | "Show canonical names and email addresses of contacts.") 120 | 121 | (defmethod git-check-ref-format ((self git-repo)) 122 | "Ensures that a reference name is well formed.") 123 | 124 | 125 | (defmethod git-column ((self git-repo)) 126 | "Display data in columns.") 127 | 128 | (defmethod git-credential ((self git-repo)) 129 | "Retrieve and store user credentials.") 130 | 131 | 132 | (defmethod git-credential-cache ((self git-repo)) 133 | "Helper to temporarily store passwords in memory.") 134 | 135 | (defmethod git-credential-store ((self git-repo)) 136 | "Helper to store credentials on disk.") 137 | 138 | (defmethod git-fmt-merge-msg ((self git-repo)) 139 | "Produce a merge commit message.") 140 | 141 | (defmethod git-interpret-trailers ((self git-repo)) 142 | "help add structured information into commit messages.") 143 | 144 | (defmethod git-mailinfo ((self git-repo)) 145 | "Extracts patch and authorship from a single e-mail message.") 146 | 147 | (defmethod git-mailsplit ((self git-repo)) 148 | "Simple UNIX mbox splitter program.") 149 | 150 | 151 | (defmethod git-merge-one-file ((self git-repo)) 152 | "The standard helper program to use with git-merge-index.") 153 | 154 | (defmethod git-patch-id ((self git-repo)) 155 | "Compute unique ID for a patch.") 156 | 157 | (defmethod git-sh-i18n ((self git-repo)) 158 | "Git's i18n setup code for shell scripts.") 159 | 160 | (defmethod git-sh-setup ((self git-repo)) 161 | "Common Git shell script setup code.") 162 | 163 | (defmethod git-stripspace ((self git-repo)) 164 | "Remove unnecessary whitespace.") 165 | -------------------------------------------------------------------------------- /src/plumbing/info.lisp: -------------------------------------------------------------------------------- 1 | ;;;; object.lisp 2 | (defpackage #:git-api.plumbing.info 3 | (:use #:cl #:alexandria #:git-api.utils #:git-api.repo) 4 | (:export)) 5 | 6 | (in-package #:git-api.plumbing.info) 7 | 8 | (from git-api.repo import git-repo) 9 | 10 | (defmethod git-cat-file ((self git-repo)) 11 | "Provide content or type and size information for repository objects.") 12 | 13 | (defmethod git-diff-files ((self git-repo)) 14 | "Compares files in the working tree and the index.") 15 | 16 | (defmethod git-diff-index ((self git-repo)) 17 | "Compare a tree to the working tree or index.") 18 | 19 | (defmethod git-diff-tree ((self git-repo)) 20 | "Compares the content and mode of blobs found via two tree objects.") 21 | 22 | (defmethod git-for-each-ref ((self git-repo)) 23 | "Output information on each ref.") 24 | 25 | (defmethod git-ls-files ((self git-repo)) 26 | "Show information about files in the index and the working tree.") 27 | 28 | (defmethod git-ls-remote ((self git-repo)) 29 | "List references in a remote repository.") 30 | 31 | (defmethod git-ls-tree ((self git-repo)) 32 | "List the contents of a tree object.") 33 | 34 | (defmethod git-merge-base ((self git-repo)) 35 | "Find as good common ancestors as possible for a merge.") 36 | 37 | (defmethod git-name-rev ((self git-repo)) 38 | "Find symbolic names for given revs.") 39 | 40 | (defmethod git-pack-redundant ((self git-repo)) 41 | "Find redundant pack files.") 42 | 43 | (defmethod git-rev-list ((self git-repo)) 44 | "Lists commit objects in reverse chronological order.") 45 | 46 | (defmethod git-show-index ((self git-repo)) 47 | "Show packed archive index.") 48 | 49 | (defmethod git-show-ref ((self git-repo)) 50 | "List references in a local repository.") 51 | 52 | (defmethod git-unpack-file ((self git-repo)) 53 | "Creates a temporary file with a blob’s contents.") 54 | 55 | (defmethod git-var ((self git-repo)) 56 | "Show a Git logical variable.") 57 | 58 | (defmethod git-verify-pack ((self git-repo)) 59 | "Validate packed Git archive files.") 60 | 61 | 62 | 63 | -------------------------------------------------------------------------------- /src/plumbing/manip.lisp: -------------------------------------------------------------------------------- 1 | ;;;; object.lisp 2 | (defpackage #:git-api.plumbing.manip 3 | (:use #:cl #:alexandria #:git-api.utils) 4 | (:export)) 5 | 6 | (in-package #:git-api.plumbing.manip) 7 | 8 | 9 | #| 10 | 11 | git-apply ((self git-repo)) 12 | 13 | Apply a patch to files and/or to the index. 14 | git-checkout-index ((self git-repo)) 15 | 16 | Copy files from the index to the working tree. 17 | git-commit-tree ((self git-repo)) 18 | 19 | Create a new commit object. 20 | git-hash-object ((self git-repo)) 21 | 22 | Compute object ID and optionally creates a blob from a file. 23 | git-index-pack ((self git-repo)) 24 | 25 | Build pack index file for an existing packed archive. 26 | git-merge-file ((self git-repo)) 27 | 28 | Run a three-way file merge. 29 | git-merge-index ((self git-repo)) 30 | 31 | Run a merge for files needing merging. 32 | git-mktag ((self git-repo)) 33 | 34 | Creates a tag object. 35 | git-mktree ((self git-repo)) 36 | 37 | Build a tree-object from ls-tree formatted text. 38 | git-pack-objects ((self git-repo)) 39 | 40 | Create a packed archive of objects. 41 | git-prune-packed ((self git-repo)) 42 | 43 | Remove extra objects that are already in pack files. 44 | git-read-tree ((self git-repo)) 45 | 46 | Reads tree information into the index. 47 | git-symbolic-ref ((self git-repo)) 48 | 49 | Read, modify and delete symbolic refs. 50 | git-unpack-objects ((self git-repo)) 51 | 52 | Unpack objects from a packed archive. 53 | git-update-index ((self git-repo)) 54 | 55 | Register file contents in the working tree to the index. 56 | git-update-ref ((self git-repo)) 57 | 58 | Update the object name stored in a ref safely. 59 | git-write-tree ((self git-repo)) 60 | 61 | Create a tree object from the current index. 62 | |# 63 | 64 | -------------------------------------------------------------------------------- /src/plumbing/sync.lisp: -------------------------------------------------------------------------------- 1 | ;;;; object.lisp 2 | (defpackage #:git-api.plumbing.sync 3 | (:use #:cl #:alexandria #:git-api.utils) 4 | (:export)) 5 | 6 | (in-package #:git-api.plumbing.sync) 7 | 8 | #| 9 | 10 | git-daemon ((self git-repo)) 11 | 12 | A really simple server for Git repositories. 13 | git-fetch-pack ((self git-repo)) 14 | 15 | Receive missing objects from another repository. 16 | git-http-backend ((self git-repo)) 17 | 18 | Server side implementation of Git over HTTP. 19 | git-send-pack ((self git-repo)) 20 | 21 | Push objects over Git protocol to another repository. 22 | git-update-server-info ((self git-repo)) 23 | 24 | Update auxiliary info file to help dumb servers. 25 | 26 | The following are helper commands used by the above; end users typically do not use them directly. 27 | 28 | git-http-fetch ((self git-repo)) 29 | 30 | Download from a remote Git repository via HTTP. 31 | git-http-push ((self git-repo)) 32 | 33 | Push objects over HTTP/DAV to another repository. 34 | git-parse-remote ((self git-repo)) 35 | 36 | Routines to help parsing remote repository access parameters. 37 | git-receive-pack ((self git-repo)) 38 | 39 | Receive what is pushed into the repository. 40 | git-shell ((self git-repo)) 41 | 42 | Restricted login shell for Git-only SSH access. 43 | git-upload-archive ((self git-repo)) 44 | 45 | Send archive back to git-archive. 46 | git-upload-pack ((self git-repo)) 47 | 48 | Send objects packed back to git-fetch-pack. 49 | |# 50 | -------------------------------------------------------------------------------- /src/repo.lisp: -------------------------------------------------------------------------------- 1 | ;;;; repo.lisp 2 | ;; 3 | ;; Usage (test) example: 4 | ;; (setf *repo* (git-api.repo:make-git-repo "~/Sources/lisp/git-api")) 5 | ;; (git-api.repo::get-commit-tree *repo* (git-api.repo:get-head-commit *repo*)) 6 | ;; 7 | 8 | (defpackage #:git-api.repo 9 | (:use #:cl #:alexandria 10 | #:git-api.utils #:git-api.pack #:git-api.object) 11 | (:export 12 | make-git-repo 13 | get-head-commit 14 | get-commit-tree 15 | get-object-by-hash 16 | get-head-hash 17 | rev-parse 18 | get-commit-parents 19 | get-commit 20 | cat-file)) 21 | 22 | (in-package #:git-api.repo) 23 | 24 | ;;---------------------------------------------------------------------------- 25 | ;; Constants 26 | ;;---------------------------------------------------------------------------- 27 | 28 | (defparameter +git-objects-dir-regexp+ (ppcre:create-scanner "(?i)/([0-9|a-f]){2}/$") 29 | "Regular expression scanner used to determine which of directories 30 | in .git/objects are containing objects (not a packfiles or info)") 31 | 32 | ;;---------------------------------------------------------------------------- 33 | ;; Conditions 34 | ;;---------------------------------------------------------------------------- 35 | (define-condition not-existing-repository-error (error) 36 | ((text :initarg :text :reader text))) 37 | 38 | (define-condition corrupted-repository-error (error) 39 | ((text :initarg :text :reader text))) 40 | 41 | 42 | ;;---------------------------------------------------------------------------- 43 | ;; Repository class 44 | ;;---------------------------------------------------------------------------- 45 | (defclass git-repo () 46 | ((path :initarg :path :reader git-repo-path 47 | :documentation "Path to the repository") 48 | (git-prefix :initform ".git/" 49 | :documentation "Prefix for the repository files - either .git or \"\" if bare repo") 50 | (object-files :reader object-files :initform (make-hash-table :test #'equal) 51 | :documentation "A hash table with the SHA1 hex as a key and filename as a value for all unpacked objects in .git/objects directory") 52 | (pack-files :reader pack-files :initform nil 53 | :documentation "List of pack-file objects") 54 | (packed-refs :reader packed-refs :initform (make-hash-table :test #'equal) 55 | :documentation "Map between ref string and SHA1 text code in packed-refs file") 56 | (annotated-tags :reader annotated-tags :initform (make-hash-table :test #'equal) 57 | :documentation "Map between ref string of annotated tag and the SHA1 text code of the commit this annotated tag points to") 58 | (commits :reader commits :initform (make-hash-table :test #'equal) 59 | :documentation "A cache of commit objects to avoid double-reading")) 60 | (:documentation "Class representing git repository")) 61 | 62 | 63 | (defun make-git-repo (path) 64 | (make-instance 'git-repo :path path)) 65 | 66 | 67 | (defmethod repo-path ((self git-repo) str) 68 | (concatenate 'string (slot-value self 'path) (slot-value self 'git-prefix) str)) 69 | 70 | 71 | (defmethod initialize-instance :after ((self git-repo) &key &allow-other-keys) 72 | "Constructor for the git-repo class" 73 | (with-slots (path pack-files packed-refs annotated-tags object-files git-prefix) self 74 | ;; append trailing "/" 75 | (unless (ends-with "/" path) 76 | (setf path (concatenate 'string path "/"))) 77 | ;; sanity checks 78 | (unless (fad:file-exists-p path) 79 | (error 'not-existing-repository-error 80 | :text (format nil "Path ~a doesn't exist" path))) 81 | ;; check if path .git exist, otherwise assume bare repository 82 | (unless (fad:file-exists-p (concatenate 'string path ".git")) 83 | (setf git-prefix "")) 84 | (unless (every #'fad:file-exists-p 85 | (mapcar (curry #'repo-path self) 86 | '("objects" "refs/heads" "refs/tags"))) 87 | (error 'corrupted-repository-error 88 | :text (format nil "Repository in ~a has a corrupted structure" path))) 89 | ;; collect all pack files 90 | (let ((files (directory (repo-path self "objects/pack/*.pack")))) 91 | (mapcar (lambda (pack) 92 | (push (parse-pack-file (namestring pack)) pack-files)) 93 | files)) 94 | ;; open file streams in pack files 95 | (dolist (pack pack-files) 96 | (pack-open-stream pack)) 97 | ;; read all refs from the packed-refs 98 | (let ((packed-refs-filename (repo-path self "packed-refs"))) 99 | (when (fad:file-exists-p packed-refs-filename) 100 | (with-open-file (stream packed-refs-filename 101 | :external-format 102 | #+(and :ccl :windows) (ccl::make-external-format :line-termination :CRLF) 103 | #-(and :ccl :windows) :default 104 | :direction :input) 105 | (let (prev-ref) ; previous ref 106 | (loop for line = (read-line stream nil) 107 | while line 108 | ;; skip comments 109 | unless (starts-with #\# (string-trim '(#\Space #\Tab) line)) 110 | do 111 | (let ((ref (split-sequence:split-sequence #\space line))) 112 | ;; check if the current line is the peeled ref (points to 113 | ;; the line above which is an annotated tag) 114 | (if (starts-with #\^ line) 115 | (setf (gethash prev-ref annotated-tags) 116 | (subseq (car ref) 1)) 117 | (setf (gethash (cadr ref) packed-refs) (car ref) 118 | prev-ref (cadr ref))))))))) 119 | ;; find all not-packed object files in repo 120 | (update-repo-objects self))) 121 | 122 | 123 | (defmethod update-repo-objects ((self git-repo)) 124 | (with-slots (object-files path) self 125 | (let ((object-dirs 126 | (remove-if-not 127 | (curry #'ppcre:scan +git-objects-dir-regexp+) 128 | (mapcar #'namestring 129 | (fad:list-directory (repo-path self "objects/")))))) 130 | (loop for dir in object-dirs 131 | do 132 | (loop for fil in (mapcar #'namestring (fad:list-directory dir)) 133 | for pos = (position #\/ fil :from-end t) 134 | do 135 | (setf (gethash 136 | (concatenate 'string (subseq fil (- pos 2) pos) 137 | (subseq fil (1+ pos))) 138 | object-files) 139 | (pathname fil))))))) 140 | 141 | 142 | 143 | (defmethod git-repo-close ((self git-repo)) 144 | ;; TODO: add this to finalizer 145 | (with-slots (pack-files) self 146 | ;; open file streams in pack files 147 | (dolist (pack pack-files) 148 | (pack-close-stream pack)))) 149 | 150 | 151 | 152 | (defmethod get-object-by-hash ((self git-repo) hash) 153 | "Returns the object by the given hash string" 154 | ;; first try if the file exists 155 | (with-slots (path pack-files object-files) self 156 | ;; no file exist 157 | (let* ((result nil) 158 | (found-pack 159 | ;; iterate oven all pack files trying to find the one having hash 160 | (loop for pack in pack-files 161 | when 162 | (= (length 163 | (setf result (multiple-value-list 164 | (pack-get-object-by-hash pack hash)))) 165 | 3) 166 | return pack))) 167 | ;; ok pack and corresponding index entry found 168 | (if (and result found-pack) 169 | ;; get the data from pack file 170 | ;; pack-get-object-by-hash returns values: (data, size, type) 171 | (let ((data (car result)) 172 | (size (cadr result)) 173 | (type (caddr result))) 174 | (when data 175 | ;; and finally parse the data 176 | (parse-git-object type 177 | data 178 | hash 179 | :start 0 180 | :size size))) 181 | ;; otherwise read git file 182 | (parse-git-file (gethash hash object-files)))))) 183 | 184 | 185 | (defmethod cat-file ((self git-repo) hash &optional (stream *standard-output*)) 186 | "Pretty-prints the contents of a object pointed by hash to the stream. 187 | If stream is not provided, using the *standard-output*. 188 | It is a wrapper around get-object-by-hash" 189 | (when-let ((contents (get-object-by-hash self hash))) 190 | (print-object contents stream))) 191 | 192 | 193 | (defmethod get-head-hash ((self git-repo)) 194 | (rev-parse self "HEAD")) 195 | 196 | 197 | (defmethod rev-parse ((self git-repo) ref) 198 | "Returns the hash string by given ref string. 199 | Examples of ref strings: 200 | @ 201 | HEAD 202 | refs/heads/master 203 | refs/tags/v1.0" 204 | (flet ((ref-or-sha1 (str) 205 | (if (not (starts-with-subseq "ref: " str)) 206 | str 207 | (second (split-sequence:split-sequence #\space str))))) 208 | (cond ((sha1-string-p ref) ref) 209 | ((or (string= ref "HEAD") 210 | (string= ref "@")) 211 | (let ((ref-file (repo-path self "HEAD"))) 212 | (when (fad:file-exists-p ref-file) 213 | (rev-parse self (ref-or-sha1 (read-one-line ref-file)))))) 214 | (t 215 | (with-slots (packed-refs) self 216 | (let ((ref-file (repo-path self ref))) 217 | ;; check if the ref is a normal file 218 | (if (fad:file-exists-p ref-file) 219 | (rev-parse self (ref-or-sha1 (read-one-line ref-file))) 220 | ;; otherwise find in packed refs 221 | (gethash ref packed-refs)))))))) 222 | 223 | 224 | (defmethod get-head-commit ((self git-repo)) 225 | (get-commit self (get-head-hash self))) 226 | 227 | 228 | (defmethod get-commit-parents ((self git-repo) (object git-api.object:commit)) 229 | (mapcar (curry #'get-commit self) (commit-parents object))) 230 | 231 | 232 | (defmethod get-commit ((self git-repo) hash) 233 | (with-slots (commits) self 234 | (if-let (commit (gethash hash commits)) 235 | commit 236 | (setf (gethash hash commits) (get-object-by-hash self hash))))) 237 | 238 | 239 | (defmethod get-commit-tree ((self git-repo) (object git-api.object:commit)) 240 | (let ((tree (make-hash-table :test #'equal)) 241 | (children (list object))) 242 | (setf (gethash (object-hash object) tree) object) 243 | (loop while children 244 | do 245 | (let* ((current (pop children)) 246 | (kids (get-commit-parents self current))) 247 | (dolist (x (remove-if (lambda(x) (gethash (object-hash x) tree)) kids)) 248 | (setf (gethash (object-hash x) tree) x) (push x children)))) 249 | tree)) 250 | -------------------------------------------------------------------------------- /src/utils.lisp: -------------------------------------------------------------------------------- 1 | ;;;; utils.lisp 2 | (defpackage #:git-api.utils 3 | (:use #:cl #:alexandria) 4 | (:export 5 | from 6 | read-one-line 7 | compiler-warning 8 | fixme 9 | todo file-size 10 | read-binary-file 11 | read-header 12 | sha1-to-hex 13 | sha1-hex-to-array 14 | sha1-string-p 15 | make-array-view)) 16 | 17 | (in-package #:git-api.utils) 18 | 19 | ;;---------------------------------------------------------------------------- 20 | ;; Constants 21 | ;;---------------------------------------------------------------------------- 22 | (defparameter *zero-ascii-begin* (char-code #\0)) 23 | (defparameter *char-ascii-begin* (char-code #\a)) 24 | (defparameter +sha1-string-regex+ (ppcre:create-scanner "^[a-f0-9]{40}$")) 25 | (declaim (type fixnum *zero-ascii-begin* *char-ascii-begin*)) 26 | 27 | 28 | ;;---------------------------------------------------------------------------- 29 | ;; Utility macros 30 | ;;---------------------------------------------------------------------------- 31 | (defmacro from (package import name &rest others) 32 | "Import symbol(s) NAME ... from the package PACKAGE. 33 | Examples: 34 | (from mediaimport.utils import interleave partition +regex-escape-chars+) 35 | (from mediaimport.ui import save-edit-controls-history) 36 | (from mediaimport.utils import *) 37 | In the last example imports all the exported symbols from the package given." 38 | (unless (string-equal import 'import) 39 | (error "Unexpected keyword: expected IMPORT, got ~A" import)) 40 | (let* ((pkg (string-upcase (symbol-name package))) ;; package name as a string 41 | (symbols ; symbols to be imported 42 | (if (and (not others) (string-equal name "*")) 43 | ;; if called like (from something import *) 44 | (let (symbols) 45 | (do-external-symbols (s pkg) 46 | (push s symbols)) 47 | symbols) 48 | ;; otherwise just arguments list 49 | (cons name others)))) 50 | `(eval-when (:compile-toplevel :load-toplevel :execute) 51 | (progn 52 | ,@(mapcar (lambda (symb) 53 | (let ((import-symbol (find-symbol (string-upcase (symbol-name symb)) pkg))) 54 | `(shadowing-import ,(list 'quote import-symbol)))) 55 | symbols))))) 56 | 57 | 58 | (defmacro read-one-line (filename) 59 | "Read exactly one first line from the file" 60 | (let ((stream-var (gensym))) 61 | `(with-open-file (,stream-var ,filename :direction :input 62 | :external-format 63 | #+(and :ccl :windows) 64 | (ccl::make-external-format :line-termination :CRLF) 65 | #-(and :ccl :windows) 66 | :default 67 | ) 68 | (read-line ,stream-var)))) 69 | 70 | 71 | (defmacro compiler-warning (datum &rest arguments) 72 | "Issue the compiler warning" 73 | (apply 'warn datum arguments)) 74 | 75 | (defmacro fixme (datum &rest arguments) 76 | "Issue the compiler warning starting with FIXME: string" 77 | (apply 'warn (concatenate 'string "FIXME: " datum) arguments)) 78 | 79 | (defmacro todo (datum &rest arguments) 80 | "Issue the compiler warning starting with TODO: string" 81 | (apply 'warn (concatenate 'string "TODO: " datum) arguments)) 82 | 83 | (defmacro defpkg (name &rest options) 84 | (let* ((options1 (copy-list options)) 85 | (use (find-if (lambda (arg) (eq (car arg) :use)) options)) 86 | ;; prepare a package name prefixed with "git-api" 87 | (pkg-name (intern 88 | (string-upcase 89 | (concatenate 'string "git-api." 90 | (string-downcase (symbol-name name)))) 91 | "KEYWORD"))) 92 | (when use 93 | ;; remove use statement from original options list, 94 | ;; we will re-construct it 95 | (removef options1 use) 96 | ;; remove heading :use 97 | (setf use (cdr use)) 98 | (print use)) 99 | ;; reconstruct new :use 100 | (pushnew ':git-api.utils use) 101 | (pushnew ':alexandria use) 102 | (pushnew ':cl use) 103 | (push ':use use) 104 | (push use options1) 105 | ;; finally create a package 106 | `(defpackage ,pkg-name ,@options1))) 107 | 108 | 109 | ;;---------------------------------------------------------------------------- 110 | ;; Utility functions 111 | ;;---------------------------------------------------------------------------- 112 | (defun file-size (filename) 113 | "Return the size of the file with the name FILENAME in bytes" 114 | (with-open-file (in filename :element-type '(unsigned-byte 8)) 115 | (file-length in))) 116 | 117 | 118 | (defun read-binary-file (filename) 119 | "Return an array of file contents" 120 | (with-open-file (stream filename :direction :input :element-type '(unsigned-byte 8)) 121 | (let* ((size (file-length stream)) 122 | (buffer (make-array size 123 | :element-type '(unsigned-byte 8) 124 | :fill-pointer t))) 125 | (read-sequence buffer stream) 126 | buffer))) 127 | 128 | 129 | (defun read-header (filename size) 130 | "Read SIZE bytes from the file FILENAME. If the file size is less than SIZE, 131 | read up to the size of file" 132 | (let ((elt-type '(unsigned-byte 8))) 133 | (with-open-file (in filename :element-type elt-type) 134 | (let* ((fsize (file-length in)) 135 | (buffer (make-array (min size fsize) :element-type elt-type))) 136 | (read-sequence buffer in) 137 | buffer)))) 138 | 139 | 140 | (defun sha1-to-hex (input &optional (offset 0)) 141 | "Reads the SHA1 code from either: 142 | - stream, 143 | - vector of unsigned bytes, 144 | - list of integers (unoptimized version, used for debugging/logging etc) 145 | - array of integers (unoptimized version, used for debugging/logging etc) 146 | returns the downcase string representing SHA1 code in hex format. 147 | NOTE: OFFSET is ignored for streams" 148 | (typecase input 149 | ((simple-array (unsigned-byte 8)) (sha1-optimized-array-to-hex input offset)) 150 | (list (sha1-list-to-hex input offset)) 151 | (stream (sha1-stream-to-hex input)) 152 | (array 'integer (sha1-normal-array-to-hex input offset)) 153 | (t nil))) 154 | 155 | 156 | (defun sha1-list-to-hex (lst offset) 157 | (string-downcase 158 | (with-output-to-string (s) 159 | (loop for i from offset below (+ offset 20) 160 | do 161 | (format s "~2,'0x" (nth i lst))) 162 | s))) 163 | 164 | (defun sha1-normal-array-to-hex (arr offset) 165 | ;; a SLOW version used only for dumping output to logs etc 166 | (string-downcase 167 | (with-output-to-string (s) 168 | (loop for i from offset below (+ offset 20) 169 | do 170 | (format s "~2,'0x" (aref arr i))) 171 | s))) 172 | 173 | 174 | 175 | (defmacro digit-to-hex (dig) 176 | "Convert number (0..15) to corresponding hex character" 177 | (let ((digit-var (gensym))) 178 | `(let ((,digit-var ,dig)) 179 | (declare (type fixnum ,digit-var)) 180 | (the character 181 | (code-char 182 | (if (< ,digit-var 10) 183 | (+ *zero-ascii-begin* ,digit-var) 184 | (+ (the fixnum (- ,digit-var 10)) *char-ascii-begin*))))))) 185 | 186 | 187 | (defun sha1-optimized-array-to-hex (array offset) 188 | ;;(declare (:explain :variables :calls)) 189 | (declare (optimize (speed 3) (safety 0) (debug 0))) 190 | (declare (type fixnum offset)) 191 | (declare (type (simple-array (unsigned-byte 8)) array)) 192 | (let ((hex (make-array 40 :element-type 'character :adjustable nil))) 193 | (dotimes (x 20) 194 | (declare (type fixnum x)) 195 | (let ((byte (aref array (the fixnum (+ x offset))))) 196 | (declare (type fixnum byte)) 197 | (let* ((upper-byte (ash byte -4)) 198 | (lower-byte (the fixnum (- byte (the fixnum (ash upper-byte 4))))) 199 | (pos (the fixnum (* 2 x)))) 200 | (declare (type fixnum offset lower-byte upper-byte)) 201 | (setf (schar hex pos) (digit-to-hex upper-byte) 202 | (schar hex (the fixnum (1+ pos))) (digit-to-hex lower-byte))))) 203 | hex)) 204 | 205 | 206 | (defun sha1-stream-to-hex (stream) 207 | (declare (optimize (speed 3) (safety 0) (debug 0))) 208 | (let ((hex (make-array 40 :element-type 'character :adjustable nil))) 209 | (dotimes (x 20) 210 | (declare (type fixnum x)) 211 | (let ((byte (read-byte stream))) 212 | (declare (type fixnum byte)) 213 | (let* ((upper-byte (ash byte -4)) 214 | (lower-byte (the fixnum (- byte (the fixnum (ash upper-byte 4))))) 215 | (pos (the fixnum (* 2 x)))) 216 | (declare (type fixnum pos lower-byte upper-byte)) 217 | (setf (schar hex pos) (digit-to-hex upper-byte) 218 | (schar hex (the fixnum (1+ pos))) (digit-to-hex lower-byte))))) 219 | hex)) 220 | 221 | 222 | (defun sha1-hex-to-array (sha1string &optional result) 223 | "Convert the given sha1 string in hex (with lower case characters) 224 | to the byte array. 225 | If RESULT array is given - write to this array" 226 | (declare (optimize (speed 3) (safety 0))) 227 | ;;(declare (:explain :variables :calls)) 228 | (declare (type (or null (simple-array (unsigned-byte 8))) result)) 229 | (unless result 230 | (setf result (make-array 20 :element-type '(unsigned-byte 8) :adjustable nil))) 231 | (macrolet ((hex-to-number (hex) 232 | (let ((hex-var (gensym))) 233 | `(let ((,hex-var (the fixnum (char-code ,hex)))) 234 | ;; (declare (type fixnum ,hex-var)) 235 | (the fixnum (if (>= ,hex-var *char-ascii-begin*) 236 | (+ 10 (the fixnum (- ,hex-var *char-ascii-begin*))) 237 | (- ,hex-var *zero-ascii-begin*))))))) 238 | (dotimes (x 20) 239 | (declare (type fixnum x)) 240 | (let* ((pos (the fixnum (* 2 x))) 241 | (upper-val (hex-to-number (schar sha1string pos))) 242 | (lower-val (hex-to-number (schar sha1string (the fixnum (1+ pos)))))) 243 | (declare (fixnum pos upper-val lower-val)) 244 | (setf (aref result x) (the fixnum (+ (the fixnum (ash upper-val 4)) lower-val)))))) 245 | result) 246 | 247 | (defun make-array-view (vector start end) 248 | "Returns array displaced to the vector (starting with start, ending on end)" 249 | (make-array (- end start 1) 250 | :displaced-to vector 251 | :displaced-index-offset start 252 | :element-type (array-element-type vector))) 253 | 254 | 255 | (defun sha1-string-p (string) 256 | (when (ppcre:scan +sha1-string-regex+ string) 257 | t)) 258 | -------------------------------------------------------------------------------- /src/zlib/cffi.lisp: -------------------------------------------------------------------------------- 1 | ;;;; cffi.lisp 2 | ;; 3 | ;; CFFI bindings to zlib 4 | ;; also exports auxulary cffi functions like memset 5 | ;; 6 | (defpackage #:git-api.zlib.cffi 7 | (:use #:cl #:cffi) 8 | (:export 9 | *zlib-loaded* 10 | uncompress 11 | z-stream 12 | zlib-version 13 | inflate-init_ 14 | inflate 15 | inflate-end 16 | memset 17 | next-in avail-in next-out avail-out total-in total-out 18 | +z-stream-size+ 19 | +z-finish+ +z-ok+ +z-stream-end+ +z-buf-error+)) 20 | 21 | (in-package #:git-api.zlib.cffi) 22 | 23 | ;;---------------------------------------------------------------------------- 24 | ;; Zlib wrapper 25 | ;;---------------------------------------------------------------------------- 26 | (define-foreign-library zlib 27 | (t (:default "libz"))) 28 | 29 | 30 | (defvar *zlib-loaded* nil 31 | "Variable set to T if we were able to load ZLIB C library") 32 | 33 | ;; try to load foreign library 34 | (ignore-errors 35 | (use-foreign-library zlib) 36 | (setf *zlib-loaded* t)) 37 | 38 | ;;---------------------------------------------------------------------------- 39 | ;; Constants 40 | ;;---------------------------------------------------------------------------- 41 | 42 | ;; Allowed flush values for deflate and inflate 43 | (defconstant +z-no-flush+ 0) 44 | (defconstant +z-partial-flush+ 1) 45 | (defconstant +z-sync-flush+ 2) 46 | (defconstant +z-full-flush+ 3) 47 | (defconstant +z-finish+ 4) 48 | (defconstant +z-block+ 5) 49 | (defconstant +z-trees+ 6) 50 | 51 | ;; Return codes for the compression/decompression functions. 52 | ;; Negative values are errors, positive values are used for special but normal events. 53 | (defconstant +z-ok+ 0) 54 | (defconstant +z-stream-end+ 1) 55 | (defconstant +z-need-dict+ 2) 56 | (defconstant +z-errno+ -1) 57 | (defconstant +z-stream-error+ -2) 58 | (defconstant +z-data-error+ -3) 59 | (defconstant +z-mem-error+ -4) 60 | (defconstant +z-buf-error+ -5) 61 | (defconstant +z-version-error+ -6) 62 | 63 | ;; Compression levels. 64 | (defconstant +z-no-compression+ 0) 65 | (defconstant +z-best-speed+ 1) 66 | (defconstant +z-best-compression+ 9) 67 | (defconstant +z-default-compression+ -1) 68 | 69 | ;; Compression strategy — see deflateInit2 for details. 70 | (defconstant +z-filtered+ 1) 71 | (defconstant +z-huffman-only+ 2) 72 | (defconstant +z-rle+ 3) 73 | (defconstant +z-fixed+ 4) 74 | (defconstant +z-default-strategy+ 0) 75 | 76 | ;; Possible values of the data_type field (though see inflate). 77 | (defconstant +z-binary+ 0) 78 | (defconstant +z-text+ 1) 79 | (defconstant +z-ascii+ +z-text+) 80 | (defconstant +z-unknown+ 2) 81 | 82 | ;; The deflate compression method (the only one supported in this version). 83 | (defconstant +z-deflated+ 8) 84 | 85 | ;; not used now but keep it for the future if more fine-tuning required 86 | (defcstruct z-stream 87 | "z_stream_s wrapper" 88 | ;; z_const Bytef *next_in; /* next input byte */ 89 | (next-in :pointer) 90 | ;; uInt avail_in; /* number of bytes available at next_in */ 91 | (avail-in :unsigned-int) 92 | ;; uLong total_in; /* total number of input bytes read so far */ 93 | (total-in :unsigned-long) 94 | ;; Bytef *next_out; /* next output byte should be put there */ 95 | (next-out :pointer) 96 | ;; uInt avail_out; /* remaining free space at next_out */ 97 | (avail-out :unsigned-int) 98 | ;; uLong total_out; /* total number of bytes output so far */ 99 | (total-out :unsigned-long) 100 | ;; z_const char *msg; /* last error message, NULL if no error */ 101 | (msg :pointer) 102 | ;; struct internal_state FAR *state; /* not visible by applications */ 103 | (state :pointer) 104 | ;; alloc_func zalloc; /* used to allocate the internal state */ 105 | (zalloc :pointer) 106 | ;; free_func zfree; /* used to free the internal state */ 107 | (zfree :pointer) 108 | ;; voidpf opaque; /* private data object passed to zalloc and zfree */ 109 | (opaque :pointer) 110 | ;; int data_type; /* best guess about the data type: binary or text */ 111 | (data-type :int) 112 | ;; uLong adler; /* adler32 value of the uncompressed data */ 113 | (adler :unsigned-long) 114 | ;; uLong reserved; /* reserved for future use */ 115 | (reserved :unsigned-long)) 116 | 117 | ;; we can only declare this parameter _after_ declaring the struct 118 | (defparameter +z-stream-size+ 119 | (if *zlib-loaded* (cffi:foreign-type-size '(:struct z-stream)) 0) 120 | "The size of z-stream structure. If zlib is not available then 0") 121 | 122 | 123 | (defcfun ("compress" compress) :int 124 | (dest (:pointer :unsigned-char)) 125 | (dest-len (:pointer :unsigned-long)) 126 | (source (:pointer :unsigned-char)) 127 | (source-len :unsigned-long)) 128 | 129 | 130 | ;;; uncompress returns Z_OK if success, Z_MEM_ERROR if there was not 131 | ;;; enough memory, Z_BUF_ERROR if there was not enough room in the output 132 | ;;; buffer, or Z_DATA_ERROR if the input data was corrupted or incomplete. 133 | (defcfun ("uncompress" uncompress) :int 134 | (dest (:pointer :unsigned-char)) 135 | (dest-len (:pointer :unsigned-long)) 136 | (source (:pointer :unsigned-char)) 137 | (source-len :unsigned-long)) 138 | 139 | 140 | ;;; const char * ZEXPORT zlibVersion 141 | (defcfun ("zlibVersion" zlib-version) (:pointer :char)) 142 | 143 | 144 | ;;; inflateInit 145 | ;; inflateInit_ 146 | ;; inflateInit_((strm), ZLIB_VERSION, (int)sizeof(z_stream) = 112) 147 | (defcfun ("inflateInit_" inflate-init_) :int 148 | (strm (:pointer (:struct z-stream))) 149 | (version :string) 150 | (sizeofstream :int)) 151 | 152 | ;;; inflate 153 | ;; int ZEXPORT inflate OF((z_streamp strm, int flush)) 154 | (defcfun ("inflate" inflate) :int 155 | (strm (:pointer (:struct z-stream))) 156 | (flush :int)) 157 | 158 | 159 | ;;; inflateEnd 160 | ;; int ZEXPORT inflateEnd OF((z_streamp strm)); 161 | (defcfun ("inflateEnd" inflate-end) :int 162 | (strm (:pointer (:struct z-stream)))) 163 | 164 | 165 | ;;; auxulary c function - memset 166 | (defcfun ("memset" memset) :int 167 | (b :pointer) 168 | (c :int) 169 | (len :unsigned-int)) 170 | 171 | 172 | (defun test-inflate-init () 173 | ;; get the size of the struct (on 64 bits and 32 bits they are different) 174 | (let ((stream-size (foreign-type-size '(:struct z-stream)))) 175 | ;; create a stream struct 176 | (with-foreign-object (strm '(:struct z-stream)) 177 | ;; clear the stream struct 178 | ;; (foreign-funcall "memset" :pointer strm :int 0 :int stream-size) 179 | (memset strm 0 stream-size) 180 | ;; initialize the stream 181 | (inflate-init_ strm (zlib-version) stream-size) 182 | (inflate-end strm)))) 183 | 184 | 185 | (defun uncompress-first-bytes (data uncompressed-size) 186 | ;; get the size of the struct (on 64 bits and 32 bits they are different) 187 | (let ((stream-size (foreign-type-size '(:struct z-stream)))) 188 | ;; create a stream struct 189 | (with-foreign-object (strm '(:struct z-stream)) 190 | ;; clear the stream struct 191 | ; (foreign-funcall "memset" :pointer strm :int 0 :int stream-size) 192 | ; (foreign-funcall "memset" :pointer strm :int 0 :int stream-size) 193 | ;; initalize values in struct 194 | (with-foreign-slots ((next-in avail-in next-out avail-out) strm (:struct z-stream)) 195 | (setf next-in data 196 | avail-in (length data) 197 | next-out nil; buf 198 | avail-out uncompressed-size)) 199 | ;; initialize the stream 200 | (inflate-init_ strm (zlib-version) stream-size) 201 | (inflate strm +z-finish+) 202 | (inflate-end strm)))) 203 | 204 | -------------------------------------------------------------------------------- /src/zlib/wrapper.lisp: -------------------------------------------------------------------------------- 1 | ;;;; wrapper.lisp 2 | ;; 3 | ;; This package reads the compressed entry from the pack file 4 | ;; 5 | (defpackage #:git-api.zlib.wrapper 6 | (:use #:cl #:alexandria #:git-api.utils #:static-vectors #:git-api.zlib.cffi) 7 | (:export *try-use-temporary-output-buffer* 8 | uncompress-stream 9 | uncompress-git-file)) 10 | 11 | (in-package #:git-api.zlib.wrapper) 12 | 13 | 14 | (defparameter *try-use-temporary-output-buffer* t 15 | "When set to T the functions will use intermediate buffers to 16 | unpack and return the data to avoid excessive memory allocations. 17 | However, then the applying deltas recursive procedures in place, 18 | the result output buffer should not be preallocated since it 19 | will be merged with itself. So for deltas processing in pack files 20 | this variable should be set to NIL") 21 | 22 | (defparameter +buffer-size+ 8192 23 | "The size of the intermediate buffer") 24 | 25 | (defparameter +git-object-header-size+ 32 26 | "The maximum size of the git object header (string \"type + size\")") 27 | 28 | (defparameter *temporary-read-buffer* (make-array +buffer-size+ 29 | :element-type '(unsigned-byte 8) 30 | :fill-pointer t) 31 | "Static read buffer used to read small amounts of data from the stream") 32 | 33 | 34 | (defparameter *temporary-output-buffer* (make-array +buffer-size+ 35 | :element-type '(unsigned-byte 8) 36 | :fill-pointer +buffer-size+) 37 | "Static output buffer used containing uncompressed data. This buffer will 38 | be returned if the uncompressed data size is less than +buffer-size+ and 39 | if the variable *try-use-temporary-output-buffer* is T") 40 | 41 | 42 | (defparameter *temporary-static-read-buffer* (make-static-vector +buffer-size+) 43 | "Static read buffer used to read small amounts of data from the stream. 44 | This buffer is used with CFFI version of zlib") 45 | 46 | 47 | (defparameter *temporary-static-output-buffer* (make-static-vector +buffer-size+) 48 | "Static output buffer used containing uncompressed data. This buffer will 49 | be returned if the uncompressed data size is less than +buffer-size+ and 50 | if the variable *try-use-temporary-output-buffer* is T. 51 | This buffer is used with CFFI version of zlib") 52 | 53 | (defparameter *git-object-header-static-buffer* (make-static-vector +git-object-header-size+) 54 | "Static buffer used to read git object header") 55 | 56 | 57 | (defvar *uncompressed-size-ptr* (cffi:foreign-alloc :unsigned-long) 58 | "A pointer to the uncompressed size used by CFFI zlib uncompress function") 59 | 60 | 61 | (define-condition zlib-error (error) 62 | ((text :initarg :text)) 63 | (:report (lambda (condition stream) 64 | (format stream "zlib error: ~a" (slot-value condition 'text))))) 65 | 66 | 67 | (defmacro unless-result-is (binding &body forms) 68 | "Defines a binding for numeric value returned by the second argument in BINDING. 69 | The binding is the local variable named RESULT. 70 | Examples: 71 | For single case: 72 | (unless (+ok+ (inflate-init_ strm (zlib-version) +z-stream-size+)) 73 | (raise \"inflate-init error: result is ~d\" result)) 74 | 75 | For multiple cases: 76 | (unless-result-is ((0 1 2) (inflate-init_ strm (zlib-version) +z-stream-size+)) 77 | (raise \"inflate-init error: result is ~d\" result))" 78 | (unless (= (length binding) 2) ; 2 arguments possible 79 | (error "2 arguments must be supplied - expected result[s] and a form")) 80 | (let* ((bindings (if (atom (car binding)) 81 | (list (car binding)) 82 | (car binding)))) 83 | `(let ((result ,(cadr binding))) 84 | (unless (or ,@(mapcar (lambda (x) `(= result ,x)) bindings)) 85 | ,@forms)))) 86 | 87 | 88 | (defmacro with-temp-static-array ((array size temp-array) &body body) 89 | "Similar to with-static-array, but tries to use temproray buffer temp-array 90 | if the size < +buffer-size+" 91 | `(let ((,array 92 | (if (or (not *try-use-temporary-output-buffer*) (> ,size +buffer-size+)) 93 | (make-static-vector ,size) 94 | ,temp-array))) 95 | (unwind-protect 96 | (locally ,@body) 97 | (unless (eq ,array ,temp-array) 98 | (free-static-vector ,array))))) 99 | 100 | 101 | (defun raise (error-text &rest args) 102 | "Raises the zlib-error condition with the format text ERROR-TEXT and format ARGS" 103 | (error 'zlib-error :text (apply #'format nil error-text args))) 104 | 105 | 106 | (declaim (inline copy-static-vector)) 107 | (defun copy-static-vector (static-vector normal-vector size &key (input-offset 0) (output-offset 0) ) 108 | "Copy the SIZE bytes from static vector STATIC-VECTOR to the lisp vector of type (unsigned-byte 8) 109 | NORMAL-VECTOR starting in source vector from INPUT-OFFSET and into the OUTPUT-OFFSET of the 110 | destination vector" 111 | (declare (optimize (speed 3) (safety 0) (debug 0) #+lispworks (float 0))) 112 | (declare (type fixnum input-offset size output-offset)) 113 | (loop for i fixnum from input-offset below (+ size input-offset) 114 | for offset fixnum = (+ i output-offset) 115 | for val = (the (unsigned-byte 8) 116 | (cffi:mem-aref (static-vector-pointer static-vector) :unsigned-char i)) 117 | do (setf (aref normal-vector offset) val)) 118 | normal-vector) 119 | 120 | 121 | (declaim (inline uncompress-stream)) 122 | (defun uncompress-stream (offset compressed-size uncompressed-size stream) 123 | "Return the zlib-uncompressed data for the stream starting with position OFFSET 124 | reading COMPRESSED-SIZE bytes and assuming uncompressed data is of size 125 | UNCOMPRESSED-SIZE bytes. This shoud be known in advance before using the function" 126 | ;; try to guess which version to use 127 | (cond 128 | ;; first try CFFI version as the fastest 129 | (git-api.zlib.cffi:*zlib-loaded* 130 | (uncompress-stream-cffi offset compressed-size uncompressed-size stream)) 131 | ;; as a fallback solution try to use patched CL zlib 132 | ;; patched means it supports manually specified output buffer 133 | ((or (> zlib::+zlib-major-version+ 0) 134 | (> zlib::+zlib-minor-version+ 1)) 135 | (uncompress-stream-patched-zlib offset compressed-size uncompressed-size stream)) 136 | ;; ... and finally try to use default (unpatched) CL zlib 137 | (t 138 | (uncompress-stream-git-zlib offset compressed-size uncompressed-size stream)))) 139 | 140 | 141 | (defun uncompress-stream-git-zlib (offset compressed-size uncompressed-size stream) 142 | "Return the uncompressed data for pack-entry from the opened file stream. 143 | This function uses the CL zlib library from https://gitlab.common-lisp.net/ 144 | This zlib library version doesn't allow to specify output buffer, hence 145 | the *try-use-temporary-output-buffer* variable will have no effect - new 146 | buffers allocated all the time" 147 | ;; move to position data-offset 148 | (file-position stream offset) 149 | ;; uncompress chunk 150 | (zlib:uncompress 151 | ;; of size compressed-size 152 | (let ((object (make-array compressed-size 153 | :element-type '(unsigned-byte 8) 154 | :fill-pointer t))) 155 | (read-sequence object stream) 156 | object) :uncompressed-size uncompressed-size)) 157 | 158 | 159 | (defun uncompress-stream-patched-zlib (offset compressed-size uncompressed-size stream) 160 | "Return the uncompressed data for pack-entry from the opened file stream. 161 | This function uses the CL zlib library from https://github.com/fourier/zlib 162 | This zlib library version allows to specify output buffer, so the implementation 163 | will take the variable *try-use-temporary-output-buffer* into consideration" 164 | ;; move to position data-offset 165 | (file-position stream offset) 166 | (let ((read-buffer 167 | (if (> compressed-size +buffer-size+) 168 | (make-array compressed-size 169 | :element-type '(unsigned-byte 8) 170 | :fill-pointer t) 171 | *temporary-read-buffer*)) 172 | (output-buffer 173 | (if (and *try-use-temporary-output-buffer* 174 | (<= uncompressed-size +buffer-size+)) 175 | (progn 176 | (setf (fill-pointer *temporary-output-buffer*) 0) 177 | *temporary-output-buffer*) 178 | (make-array uncompressed-size 179 | :element-type '(unsigned-byte 8) 180 | :fill-pointer 0)))) 181 | ;; sanity check 182 | (assert (>= (array-total-size read-buffer) compressed-size)) 183 | ;; read the data 184 | (read-sequence read-buffer stream :end compressed-size) 185 | ;; uncompress chunk 186 | (zlib:uncompress read-buffer :output-buffer output-buffer :start 0 :end compressed-size))) 187 | 188 | 189 | (defun uncompress-stream-cffi (offset compressed-size uncompressed-size stream) 190 | "Return the uncompressed data for pack-entry from the opened file stream. 191 | This function uses the C zlib library using CFFI. The implementation 192 | will take the variable *try-use-temporary-output-buffer* into consideration" 193 | ;; move to position data-offset 194 | (file-position stream offset) 195 | (let ((input *temporary-static-read-buffer*) 196 | (output *temporary-static-output-buffer*) 197 | (output-buffer *temporary-static-output-buffer*)) 198 | ;; set value of the pointer to size output buffer 199 | (setf (cffi:mem-ref *uncompressed-size-ptr* :unsigned-long) uncompressed-size) 200 | (handler-case 201 | (progn 202 | ;; check if we requested to use temporary buffers 203 | (unless *try-use-temporary-output-buffer* 204 | (setf input (make-static-vector compressed-size) 205 | output (make-static-vector uncompressed-size) 206 | output-buffer (make-array uncompressed-size 207 | :element-type '(unsigned-byte 8)))) 208 | ;; check if size of input buffer suits 209 | (when (and *try-use-temporary-output-buffer* (> compressed-size +buffer-size+)) 210 | (setf input (make-static-vector compressed-size))) 211 | ;; and check if size of output buffer suits 212 | (when (and *try-use-temporary-output-buffer* (> uncompressed-size +buffer-size+)) 213 | (setf output (make-static-vector uncompressed-size) 214 | output-buffer (make-array uncompressed-size 215 | :element-type '(unsigned-byte 8)))) 216 | ;; read the data 217 | (read-sequence input stream :end compressed-size) 218 | ;; uncompress chunk 219 | ;; check for error 220 | (unless-result-is (0 (git-api.zlib.cffi:uncompress 221 | (static-vector-pointer output) 222 | *uncompressed-size-ptr* 223 | (static-vector-pointer input) 224 | compressed-size)) 225 | (raise "zlib::uncompress returned ~d" result)) 226 | ;; if necessary convert data from C to LISP format 227 | (unless (eq output-buffer *temporary-static-output-buffer*) 228 | (copy-static-vector output output-buffer uncompressed-size)) 229 | ;; if necessary remove foreign arrays 230 | (unless (eq input *temporary-static-read-buffer*) 231 | (free-static-vector input)) 232 | (unless (eq output *temporary-static-output-buffer*) 233 | (free-static-vector output)) 234 | ;; good, output buffer now contains the data 235 | output-buffer) 236 | (error (e) 237 | (progn 238 | ;; if necessary remove foreign arrays 239 | (unless (eq input *temporary-static-read-buffer*) 240 | (free-static-vector input)) 241 | (unless (eq output *temporary-static-output-buffer*) 242 | (free-static-vector output)) 243 | (error e)))))) 244 | 245 | 246 | (declaim (inline uncompress-git-file)) 247 | (defun uncompress-git-file (filename) 248 | "Uncompress the file with git object - blob, commit etc. 249 | Will try to uncompress used C zlib if available, if not fallback 250 | to the CL zlib" 251 | ;; try to guess which version to use 252 | (if git-api.zlib.cffi:*zlib-loaded* 253 | ;; first try CFFI version as the fastest 254 | (uncompress-git-file-cffi filename) 255 | (uncompress-git-file-zlib filename))) 256 | 257 | 258 | 259 | (defun uncompress-git-file-zlib (filename) 260 | "Uncompress the file with git object using CL zlib library" 261 | ;; (with-open-file (stream filename :direction :input :element-type '(unsigned-byte 8)) 262 | ;; (chipz:decompress nil 'chipz:zlib stream))) 263 | (let ((data (read-binary-file filename))) 264 | (zlib:uncompress data))) 265 | 266 | 267 | (defun uncompress-git-file-cffi (filename) 268 | "Uncompress the git object file using C-version of ZLIB" 269 | ;; Git object format: 270 | ;; header\0(content) 271 | ;; where the header is: {type string}#\Space{content size string} 272 | ;; From this the uncompressed size is (header size) + 1 + (content size) 273 | ;; Algorithm: 274 | ;; 1. Read up to 32 (+git-object-header-size+) bytes of output buffer 275 | ;; 2. Parse the input 276 | ;; 3. If content size <= 32 - (header size + 1) 277 | ;; meaning it fit completely into the 32 bytes, just return the result 278 | ;; 4. Otherwise if content size < 8192 - (header size + 1) 279 | ;; meaning we can use pre-allocated buffer - use it 280 | ;; 5. Otherwise allocate the buffer of the size (header size + 1 + content size) and use it 281 | ;; open the stream and read the file contents into the static vector 282 | (with-open-file (stream filename :direction :input :element-type '(unsigned-byte 8)) 283 | (let ((size (file-length stream))) 284 | (with-temp-static-array (input size *temporary-static-read-buffer*) 285 | (read-sequence input stream) 286 | ;; create a stream struct 287 | (cffi:with-foreign-object (strm '(:struct z-stream)) 288 | ;; clear the stream struct 289 | (memset strm 0 +z-stream-size+) 290 | ;; initalize values in struct 291 | (cffi:with-foreign-slots ((next-in avail-in next-out avail-out total-out) 292 | strm (:struct z-stream)) 293 | (setf next-in (static-vector-pointer input) 294 | avail-in (min +buffer-size+ size) ; read no more than +buffer-size+ bytes - it is enough to read a header 295 | next-out (static-vector-pointer *git-object-header-static-buffer*) 296 | ;; header assumed to be is no more than 32 bytes, 297 | ;; at least in Git implementation itself it is the assumption 298 | avail-out +git-object-header-size+) 299 | (format t "avail-in ~a avail-out ~a total-out ~a~%" 300 | avail-in avail-out total-out) 301 | ;; initialize the stream 302 | (unless-result-is (+z-ok+ (inflate-init_ strm (zlib-version) +z-stream-size+)) 303 | (raise "zlib inflate-init returned ~d on a file ~a" result filename)) 304 | (unwind-protect 305 | (let ((result (inflate strm +z-finish+))) 306 | (unless (or (= result +z-stream-end+) 307 | (= result +z-buf-error+) 308 | (= result +z-ok+)) 309 | (raise "zlib inflate returned ~d while unpacking header on a file ~a" result filename)) 310 | (format t "avail-in ~a avail-out ~a total-out ~a result ~a~%" 311 | avail-in avail-out total-out result) 312 | ;; when we have uncompressed everything, meaning 313 | ;; header + size <= 32 bytes, 314 | ;; just return result as a copy of static buffer 315 | (if (= result +z-stream-end+) 316 | (copy-static-vector *git-object-header-static-buffer* 317 | (make-array total-out :element-type '(unsigned-byte 8)) 318 | total-out) 319 | ;; otherwise find the end of the header with type and size 320 | (let* ((header-size (position 0 *git-object-header-static-buffer*)) 321 | (content-size (parse-integer 322 | (babel:octets-to-string *git-object-header-static-buffer* 323 | :start (1+ (position 32 *git-object-header-static-buffer*)) 324 | :end header-size))) 325 | (uncompressed-size (+ 1 header-size content-size)) 326 | ;; create the output vector 327 | (content (make-array uncompressed-size 328 | :element-type '(unsigned-byte 8)))) 329 | (format t "header-size ~a content-size ~a uncompressed-size ~a~%" 330 | header-size content-size uncompressed-size) 331 | ;; first take the first 32 uncompressed bytes of header + parts of content... 332 | (copy-static-vector *git-object-header-static-buffer* 333 | content 334 | +git-object-header-size+) 335 | ;; finally allocate static vector to uncompress the rest of the data 336 | ;; the static vector size is at maximum content-size, 337 | ;; but could be (typically) less since parts of content was already 338 | ;; uncompressed to the *git-object-header-static-buffer* 339 | (with-temp-static-array (static-content content-size *temporary-static-output-buffer*) 340 | ;; update stream with the rest of the data 341 | (setf avail-in (- size avail-in) 342 | avail-out content-size 343 | next-out (static-vector-pointer static-content)) 344 | ;; and finally uncompress the rest 345 | (unless-result-is ((+z-ok+ +z-stream-end+) (inflate strm +z-finish+)) 346 | (raise "zlib inflate returned ~d on a file ~a" result filename)) 347 | ;; ... and then take the remaining uncompressed content 348 | (copy-static-vector static-content 349 | content 350 | (- uncompressed-size +git-object-header-size+) 351 | :output-offset +git-object-header-size+)))))) 352 | (inflate-end strm))))))) 353 | 354 | 355 | 356 | (defun uncompress-git-file-cffi1 (filename) 357 | "Uncompress the git object file using C-version of ZLIB" 358 | ;; Git object format: 359 | ;; header\0(content) 360 | ;; where the header is: {type string}#\Space{content size string} 361 | ;; From this the uncompressed size is (header size) + 1 + (content size) 362 | ;; Algorithm: 363 | ;; 1. Read up to 32 (+git-object-header-size+) bytes of output buffer 364 | ;; 2. Parse the input 365 | ;; 3. If content size <= 32 - (header size + 1) 366 | ;; meaning it fit completely into the 32 bytes, just return the result 367 | ;; 4. Otherwise if content size < 8192 - (header size + 1) 368 | ;; meaning we can use pre-allocated buffer - use it 369 | ;; 5. Otherwise allocate the buffer of the size (header size + 1 + content size) and use it 370 | ;; open the stream and read the file contents into the static vector 371 | (with-open-file (stream filename :direction :input :element-type '(unsigned-byte 8)) 372 | (let ((size (file-length stream)) 373 | (content (make-array +buffer-size+ :element-type '(unsigned-byte 8) :adjustable t))) 374 | (with-temp-static-array (input size *temporary-static-read-buffer*) 375 | (read-sequence input stream) 376 | ;; create a stream struct 377 | (cffi:with-foreign-object (strm '(:struct z-stream)) 378 | ;; clear the stream struct 379 | (memset strm 0 +z-stream-size+) 380 | ;; initalize values in struct 381 | (cffi:with-foreign-slots ((next-in avail-in next-out avail-out total-out) 382 | strm (:struct z-stream)) 383 | (setf next-in (static-vector-pointer input) 384 | avail-in (min +buffer-size+ size) ; read no more than +buffer-size+ bytes - it is enough to read a header 385 | next-out (static-vector-pointer *git-object-header-static-buffer*) 386 | ;; header assumed to be is no more than 32 bytes, 387 | ;; at least in Git implementation itself it is the assumption 388 | avail-out +git-object-header-size+) 389 | (format t "avail-in ~a avail-out ~a total-out ~a~%" 390 | avail-in avail-out total-out) 391 | ;; initialize the stream 392 | (unless-result-is (+z-ok+ (inflate-init_ strm (zlib-version) +z-stream-size+)) 393 | (raise "zlib inflate-init returned ~d on a file ~a" result filename)) 394 | (unwind-protect 395 | (let ((result (inflate strm +z-finish+))) 396 | (unless (or (= result +z-stream-end+) 397 | (= result +z-buf-error+) 398 | (= result +z-ok+)) 399 | (raise "zlib inflate returned ~d while unpacking header on a file ~a" result filename)) 400 | (format t "avail-in ~a avail-out ~a total-out ~a result ~a~%" 401 | avail-in avail-out total-out result) 402 | ;; when we have uncompressed everything, meaning 403 | ;; header + size <= 32 bytes, 404 | ;; just return result as a copy of static buffer 405 | (if (= result +z-stream-end+) 406 | (copy-static-vector *git-object-header-static-buffer* 407 | (make-array total-out :element-type '(unsigned-byte 8)) 408 | total-out) 409 | ;; otherwise find the end of the header with type and size 410 | (let* ((header-size (position 0 *git-object-header-static-buffer*)) 411 | (content-size (parse-integer 412 | (babel:octets-to-string *git-object-header-static-buffer* 413 | :start (1+ (position 32 *git-object-header-static-buffer*)) 414 | :end header-size))) 415 | (uncompressed-size (+ 1 header-size content-size)) 416 | ;; create the output vector 417 | (content (make-array uncompressed-size 418 | :element-type '(unsigned-byte 8)))) 419 | (format t "header-size ~a content-size ~a uncompressed-size ~a~%" 420 | header-size content-size uncompressed-size) 421 | ;; first take the first 32 uncompressed bytes of header + parts of content... 422 | (copy-static-vector *git-object-header-static-buffer* 423 | content 424 | +git-object-header-size+) 425 | ;; finally allocate static vector to uncompress the rest of the data 426 | ;; the static vector size is at maximum content-size, 427 | ;; but could be (typically) less since parts of content was already 428 | ;; uncompressed to the *git-object-header-static-buffer* 429 | (with-temp-static-array (static-content content-size *temporary-static-output-buffer*) 430 | ;; update stream with the rest of the data 431 | (setf avail-in (- size avail-in) 432 | avail-out content-size 433 | next-out (static-vector-pointer static-content)) 434 | ;; and finally uncompress the rest 435 | (unless-result-is ((+z-ok+ +z-stream-end+) (inflate strm +z-finish+)) 436 | (raise "zlib inflate returned ~d on a file ~a" result filename)) 437 | ;; ... and then take the remaining uncompressed content 438 | (copy-static-vector static-content 439 | content 440 | (- uncompressed-size +git-object-header-size+) 441 | :output-offset +git-object-header-size+)))))) 442 | (inflate-end strm))))))) 443 | 444 | 445 | -------------------------------------------------------------------------------- /t/attributes-test.lisp: -------------------------------------------------------------------------------- 1 | ;;;; attributes-test.lisp 2 | ;; NOTE: To run this test file, execute `(asdf:test-system :git-api)' in your Lisp. 3 | ;; 4 | 5 | (in-package :cl-user) 6 | (defpackage git-api.test.attributes-test 7 | (:use :cl 8 | :git-api.utils 9 | :git-api.test.base 10 | :git-api.plumbing.helpers.details.attributes 11 | :prove)) 12 | (in-package :git-api.test.attributes-test) 13 | 14 | 15 | (from git-api.plumbing.helpers.details.attributes import 16 | parse-collected-attributes) 17 | 18 | (plan nil) 19 | 20 | (subtest "Testing parse-collected-attributes" 21 | (is (parse-collected-attributes '("-diff" "-merge" "-text")) 22 | '(("diff" . :unset) ("merge" . :unset) ("text" . :unset)) 23 | :test #'equalp 24 | "Testing input: ('-diff' '-merge' '-text')")) 25 | 26 | (subtest "Testing parse-attribute-line" 27 | (is (parse-attribute-line "a* foo !bar -baz") 28 | (cons "a*" '(("foo" . :set) ("bar" . :unspecified) ("baz" . :unset))) 29 | :test #'equalp 30 | "Testing input: 'a* foo !bar -baz'") 31 | 32 | (is (parse-attribute-line "abc foo bar baz") 33 | (cons "abc" '(("foo" . :set) ("bar" . :set) ("baz" . :set))) 34 | :test #'equalp 35 | "Testing input: 'abc foo bar baz'") 36 | 37 | (is (parse-attribute-line "ab* merge=filfre") 38 | (cons "ab*" '(("merge" . "filfre"))) 39 | :test #'equalp 40 | "Testing input: 'ab* merge=filfre'") 41 | 42 | (is (parse-attribute-line "abc -foo -bar") 43 | (cons "abc" '(("foo" . :unset) ("bar" . :unset))) 44 | :test #'equalp 45 | "Testing input: 'abc -foo -bar'") 46 | 47 | (is (parse-attribute-line "*.c frotz") 48 | (cons "*.c" '(("frotz" . :set))) 49 | :test #'equalp 50 | "Testing input: '*.c frotz")) 51 | 52 | 53 | (subtest "Test parse-attribute-macro" 54 | (is (parse-attribute-macro "[attr]binary -diff -merge -text") 55 | '("binary" ("diff" . :unset) ("merge" . :unset) ("text" . :unset)) 56 | "Testing input: '[attr]binary -diff -merge -text'")) 57 | 58 | 59 | (finalize) 60 | -------------------------------------------------------------------------------- /t/base.lisp: -------------------------------------------------------------------------------- 1 | ;;;; base.lisp 2 | ;; File containing common settings for all unit tests 3 | ;; 4 | (in-package :cl-user) 5 | (defpackage git-api.test.base 6 | (:use :cl 7 | :prove) 8 | (:export testfile random-shuffle random-shufflef)) 9 | 10 | 11 | (in-package :git-api.test.base) 12 | 13 | ;; turn off ansi colors in report output 14 | (setf prove.color:*enable-colors* nil) 15 | ;; change type of the reporter to Test Anything Protocol 16 | (setf prove:*default-reporter* :tap) 17 | 18 | (defvar *test-data-path* (fad:merge-pathnames-as-directory (asdf:system-relative-pathname :git-api-test #P"t/") #P"data/")) 19 | 20 | (defun testfile (filename) 21 | (merge-pathnames filename *test-data-path*)) 22 | 23 | 24 | (defmethod random-shufflef ((container list)) 25 | (let ((n (length container))) 26 | (loop for i from (- n 1) downto 0 27 | do 28 | (rotatef (nth i container) (nth (random (+ i 1)) container))) 29 | container)) 30 | 31 | 32 | (defmethod random-shufflef ((container array)) 33 | (let ((n (length container))) 34 | (loop for i from (- n 1) downto 0 35 | do 36 | (rotatef (aref container i) (aref container (random (+ i 1))))) 37 | container)) 38 | 39 | (defmethod random-shuffle ((container list)) 40 | (let ((result (copy-list container)) 41 | (n (length container))) 42 | (loop for i from (- n 1) downto 0 43 | do 44 | (rotatef (nth i result) (nth (random (+ i 1)) result))) 45 | result)) 46 | 47 | 48 | (defmethod random-shuffle ((container array)) 49 | (let ((result (copy-seq container)) 50 | (n (length container))) 51 | (loop for i from (- n 1) downto 0 52 | do 53 | (rotatef (aref result i) (aref result (random (+ i 1))))) 54 | result)) -------------------------------------------------------------------------------- /t/coverage.lisp: -------------------------------------------------------------------------------- 1 | ;;;; coverage.lisp 2 | ;; File containing functionality for the test coverage setup 3 | ;; 4 | (in-package :cl-user) 5 | (defpackage git-api.test.coverage 6 | (:use :cl :asdf) 7 | (:export run-tests-with-coverage)) 8 | 9 | (in-package :git-api.test.coverage) 10 | 11 | #+lispworks7 12 | (defun generate-coverage-output-path () 13 | (multiple-value-bind (second minute hour date month year);; day) 14 | (get-decoded-time) 15 | (let ((results-directory-name 16 | (pathname 17 | (format nil "git-api-coverage_~4,'0d-~2,'0d-~2,'0d_~2,'0d_~2,'0d_~2,'0d/index.html" 18 | year month date hour minute second)))) 19 | 20 | (merge-pathnames results-directory-name (hcl:get-temp-directory))))) 21 | 22 | 23 | #+lispworks7 24 | (defun run-lw-test-coverage () 25 | (hcl:clear-code-coverage) 26 | (hcl:with-code-coverage-generation () 27 | (asdf/operate:load-system :git-api :force t)) 28 | (asdf/operate:test-system :git-api-test) 29 | (let ((output-file (generate-coverage-output-path))) 30 | (hcl:code-coverage-data-generate-coloring-html output-file) 31 | (format *standard-output* "Generated coverage report to ~a" output-file) 32 | #+macosx 33 | (objc:invoke (objc:invoke "NSWorkspace" "sharedWorkspace") "openURL:" 34 | (objc:invoke "NSURL" "URLWithString:" 35 | (concatenate 'string "file://" (namestring output-file)))))) 36 | 37 | 38 | (defun run-tests-with-coverage () 39 | #+lispworks7 40 | (run-lw-test-coverage) 41 | #-lispworks7 42 | (error "Code coverage generation currently supported only on LispWorks 7 and above")) 43 | 44 | 45 | 46 | -------------------------------------------------------------------------------- /t/data/binary.dat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/binary.dat -------------------------------------------------------------------------------- /t/data/corrupted_pack0.idx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/corrupted_pack0.idx -------------------------------------------------------------------------------- /t/data/corrupted_pack0.pack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/corrupted_pack0.pack -------------------------------------------------------------------------------- /t/data/corrupted_pack1.idx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/corrupted_pack1.idx -------------------------------------------------------------------------------- /t/data/corrupted_pack1.pack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/corrupted_pack1.pack -------------------------------------------------------------------------------- /t/data/corrupted_pack2.idx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/corrupted_pack2.idx -------------------------------------------------------------------------------- /t/data/corrupted_pack2.pack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/corrupted_pack2.pack -------------------------------------------------------------------------------- /t/data/example-objects/52/00e67faf9a9a39b916f7779fe98bcaa47eda0c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/example-objects/52/00e67faf9a9a39b916f7779fe98bcaa47eda0c -------------------------------------------------------------------------------- /t/data/example-objects/52/4acfffa760fd0b8c1de7cf001f8dd348b399d8: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/example-objects/52/4acfffa760fd0b8c1de7cf001f8dd348b399d8 -------------------------------------------------------------------------------- /t/data/example-objects/big-git-object.dat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/example-objects/big-git-object.dat -------------------------------------------------------------------------------- /t/data/example-objects/small-git-object.dat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/example-objects/small-git-object.dat -------------------------------------------------------------------------------- /t/data/example-repo-extracted/96057f0a67f7ad0d334820689410fd65a25e47c4.contents: -------------------------------------------------------------------------------- 1 | 100644 blob 9eeff76aaa278e9253b0106dfab6b8ab2619d695 lorem_10p.txt 2 | -------------------------------------------------------------------------------- /t/data/example-repo-extracted/9eeff76aaa278e9253b0106dfab6b8ab2619d695.contents: -------------------------------------------------------------------------------- 1 | 2 | 3 | Lorem ipsum dolor t amet, consectetur adipiscing elit. auctor s erosr lorem, ut tristique velit mollis ar lorem, ut tristique velit mollis a, in egestas nibh fringilla quis. Aenean nec euismod lectus. Nullam rhoncus sapien aoeuaoeuaoeuquis porta. Donec imperdiet aoeuaoeuvarius tortor id 5555youtpat. Aliquam erat volutpat. Quisque suscipit lacus ac augue venenatis maximus. Morbi et tincidunt arcu, ac egestas dui. Nunc faucibus, mauris id auctor dignissim, ipsum massa faucibus metus, id finibus urna est at justo. Cras hendrerit, turpis laoreet viverra semper, felis lorem porttitor ex, ac maximus quam dolor vitae leo. Sed sit amet neque id eros elementum consectetur a a sem. Nunc consequat tellus magna, in aliquam odio varius vel. Integer efficitur, nisl non posuere pretium, neque nulla consectetur neque, posuere lacinia nibh leo sed nibh. 4 | 5 | Nunc placerat nunc condimentum nulla rutrum sagittis. Ut commodo tempor lorem, ut tristique velit mollis a. Nunc feugiat sapien mauris, sed iaculis libero fermentum eget. Nullam tincidunt, orci in commodo auctor, sapien augue feugiat turpis, a posuere leo ante vitae nulla. Donec dictum lorem saoeuit amet lacus ullamcorper viverra. Donec vehicula ex eget diam euismod, eget molestie tellus tempor. Aenean sed ex sagittis, ullamcorper leo vel, eleifend nulla. Praesent vel augue metus. Quisque interdum diam sed consequat malesuada. Nulla interdum mollis nisi a dictum. Nunc elit tellus, luctus vitae nulla ut, volutpat egestas augue. Praesent vel iaculis quam. Integer eu nunc in nisl luctus fringilla eget faucibus urna. 6 | 7 | l 8 | Morbi scelerisque, nibh et laoreet molestie, sem ante ullamcorper arcu, quis sagittis urna turpis vitae metus. Maecenas condimentum metus lorem, a fringilla nunc feugiat eget. Sed ut magna commodo dui pharetra molestie. Nam iaculis lorem non molestie vulputate. Nulla a risus eget erat ultricies venenatis facilisis eu neque. Nulla facilisi. Mauris congue vehicula nunc, in consectetur erat aliquam at. Pellentesque non porta ex. 9 | 10 | Vivamus vestibulum sed tellus ut euismod. Sed in nulla diam. Fusce nisi urna, hendrerit ut eros sit amet, dignissim dapibus nisi. Curabitur semper feugiat mauris sed vestibulum. Nullam nec sem pulvinar, pellentesque augue sit amet, consequat nisi. Aenean suscipit, erat non rutrum ornare, felis nibh ultricies nulla, et vehicula justo nulla convallis dolor. Quisque vitae malesuada purus. Donec egestas mattis dignissim. 11 | 12 | Donec commodo est aoeu aoeu a aoidui. Mwaoeu ao aecenas pharetra gwoeu a ravida ipsum noeu aeou wwwec mattis. Ioeuwn c . Proiuaoeauoeu n pretium nunc metusdwwwwao, vitae ultricies turpis egestas viverraCurabitur nec neque ,u43pujoaeuligula volutpat condimentum vel ac lacus. Cras elementum erat maximus, feugiat orci in, porta nisi. Ut elit quam, lobortis a mollis hendrerit, fringilla in nibh. Sed mattis turpis enim, nec egestas velit interdum in. Morbi non sodales enim. Sed id quam purus. Pellentesque habitant morbi tristique senectus et netus et malesuada fames ac turpis egestas. Proin a vestibulum turpis. 13 | 14 | Mauris fermentum a augue eu euismod. Ut lacus lacus, mollis in magna sed, ultrices blandit quam. Donec semper dolor at erat malesuada, ac lobortis ipsum lobortis. Vivamus sed nulla at nunc mollis bibendum ut nec enim. Morbi ullamcorper ornare lacinia. In vestibulum eu nunc non varius. Sed ac blandit neque, pellentesque aliquam sapien. Phasellus interdum sapien mi, non ultricies sapien pulvinar nec. Sed tempor eu magna sed tincidunt. Integer rhoncus interdum ullamcorper. Suspendisse dui quam, tristique at iaculis sed, porta sit amet urna. 15 | 16 | Vivamus quis iaculis urna. Integer bibendum lorem hendrerit consequat semper. Donec laoreet dictum turpis at consectetur. Nam interdum quam vitae odio imperdiet laoreet. Suspendisse pulvinar nec massa non gravida. Phasellus at arcu enim. Fusce nisi nibh, suscipit sit amet quam eget, tincidunt volutpat lacus. Suspendisse egestas imperdiet lectus, et semper est lacinia a. Curabitur condimentum, nisi eget aliquet fringilla, diam enim efficitur dolor, vel laoreet eros urna non mi. Pellentesque ipsum lorem, semper sed maximus vel, placerat quis dolor. Mauris vehicula consectetur malesuada. Vestibulum ante ipsum primis in faucibus orci luctus et ultrices posuere cubilia Curae; Sed iaculis magna sit amet maximus ullamcorper. 17 | 18 | Vivamus dolor eros, suscipit in faucibus at, tincidunt nec massa. Donec at porta mauris, nec porta nulla. Quisque auctor leo ut diam mattis, at finibus ipsum condimentum. Vestibulum vitae tristique augue, id iaculis augue. Cras efficitur maximus pretium. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos himenaeos. Pellentesque eget felis dolor. Donec at risus quis dolor fringilla pulvinar. Nam sit amet justo massa. Nam feugiat lacus vel urna interdum, in aliquam magna pulvinar. Proin dignissim felis lectus, at posuere diam pulvinar id. Integer nec libero in dolor imperdiet pellentesque. Pellentesque magna urna, tincidunt eget orci eu, interdum tincidunt sapien. Phasellus lacinia malesuada enim, at fermentum arcu mollis in. Duis magna tellus, dapibus sed magna at, aliquam porttitor leo. Aliquam ultricies ex id scelerisque elementum. 19 | 20 | Fusce rhoncus vulputate turpis, fringilla suscipit urna convallis at. Sed a efficitur lectus. Aliquam vitae ipsum sit amet augue pharetra ornare. Vestibulum ac nunc vitae risus fermentum tristique. Pellentesque id lobortis mauris. Pellentesque condimentum consequat fermentum. Proin in aliquam metus. Fusce nec dolor leo. Sed non sagittis purus. Aliquam dolor lorem, volutpat at laoreet non, dapibus vitae ipsum. Nulla vel lorem sapien. 21 | Generated 10 paragraphs, 927 words, 6239 bytes of Lorem Ipsum 22 | -------------------------------------------------------------------------------- /t/data/example-repo-extracted/cb96e53d08dbfc0d358c5f312029aecaf584a390.contents: -------------------------------------------------------------------------------- 1 | tree aca7baf1ea0bc6cc23f92edf55ac2e4ea6586f21 2 | parent a2194f882da560df01357af06a4a7cc91614ee94 3 | author Alexey Veretennikov 1478720297 +0100 4 | committer Alexey Veretennikov 1478720297 +0100 5 | 6 | Added another file 7 | -------------------------------------------------------------------------------- /t/data/example-repo-extracted/dee95d63ff98bc1b1ef6e26ae7d83eb40d653d3e.contents: -------------------------------------------------------------------------------- 1 | Lorem ipsum dolor sit amet, consectetur adipiscing elit. Vivamus quis ligula vulputate, aliquet lectus vitae, mollis eros. Duis nisl lacus, finibus sit amet elit quis, accumsan bibendum orci. Proin dignissim, tortor a tristique pellentesque, libero lectus facilisis libero, bibendum suscipit tortor dui et orci. Fusce non ex quis quam faucibus pretium. Phasellus quis lorem et tellus efficitur pharetra id ornare justo. Ut egestas sem a consectetur tempus. Mauris aliquet dolor quis libero aliquam blandit. 2 | 3 | Nulla efficitur ornare est non dapibus. Sed congue id ex sed fermentum. Vivamus nisi libero, gravida nec leo non, vulputate pulvinar sapien. Sed bibendum orci feugiat commodo hendrerit. Aliquam mauris arcu, lacinia sit amet ullamcorper eu, vulputate id dolor. Quisque id sapien sed ipsum sodales malesuada facilisis malesuada purus. Aenean bibendum, augue non ullamcorper sodales, velit eros ornare ipsum, at malesuada est nisi in nunc. Suspendisse potenti. Nam condimentum vitae diam eu ullamcorper. Fusce eget cursus velit. Interdum et malesuada fames ac ante ipsum primis in faucibus. 4 | 5 | Maecenas interdum sollicitudin odio vitae molestie. Quisque ultricies pretium nunc vel pulvinar. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Ut id vulputate ex, in scelerisque urna. Fusce vitae dignissim dolor, nec dictum diam. Curabitur a arcu tellus. Mauris a cursus erat, non pharetra justo. Donec sit amet ante eu arcu ullamcorper iaculis sed vel ligula. Duis sagittis, diam id varius hendrerit, nulla metus tincidunt augue, sit amet condimentum arcu lacus eget nunc. Maecenas in dolor venenatis, feugiat nisl at, dictum mauris. In orci elit, auctor vel dui ac, semper tempus mauris. Integer aliquet id orci non aliquet. Nam vulputate gravida erat vitae fermentum. Nam sit amet dui placerat, ullamcorper ex nec, egestas lectus. Nam eget tempus mi. Quisque a ultricies quam, a faucibus risus. Proin maximus congue turpis at volutpat. Lorem ipsum dolor sit. 6 | -------------------------------------------------------------------------------- /t/data/example-repo/COMMIT_EDITMSG: -------------------------------------------------------------------------------- 1 | Added another file 2 | -------------------------------------------------------------------------------- /t/data/example-repo/HEAD: -------------------------------------------------------------------------------- 1 | ref: refs/heads/master 2 | -------------------------------------------------------------------------------- /t/data/example-repo/config: -------------------------------------------------------------------------------- 1 | [core] 2 | repositoryformatversion = 0 3 | filemode = true 4 | bare = false 5 | logallrefupdates = true 6 | ignorecase = true 7 | precomposeunicode = true 8 | -------------------------------------------------------------------------------- /t/data/example-repo/description: -------------------------------------------------------------------------------- 1 | Unnamed repository; edit this file 'description' to name the repository. 2 | -------------------------------------------------------------------------------- /t/data/example-repo/hooks/applypatch-msg.sample: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # An example hook script to check the commit log message taken by 4 | # applypatch from an e-mail message. 5 | # 6 | # The hook should exit with non-zero status after issuing an 7 | # appropriate message if it wants to stop the commit. The hook is 8 | # allowed to edit the commit message file. 9 | # 10 | # To enable this hook, rename this file to "applypatch-msg". 11 | 12 | . git-sh-setup 13 | commitmsg="$(git rev-parse --git-path hooks/commit-msg)" 14 | test -x "$commitmsg" && exec "$commitmsg" ${1+"$@"} 15 | : 16 | -------------------------------------------------------------------------------- /t/data/example-repo/hooks/commit-msg.sample: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # An example hook script to check the commit log message. 4 | # Called by "git commit" with one argument, the name of the file 5 | # that has the commit message. The hook should exit with non-zero 6 | # status after issuing an appropriate message if it wants to stop the 7 | # commit. The hook is allowed to edit the commit message file. 8 | # 9 | # To enable this hook, rename this file to "commit-msg". 10 | 11 | # Uncomment the below to add a Signed-off-by line to the message. 12 | # Doing this in a hook is a bad idea in general, but the prepare-commit-msg 13 | # hook is more suited to it. 14 | # 15 | # SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p') 16 | # grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1" 17 | 18 | # This example catches duplicate Signed-off-by lines. 19 | 20 | test "" = "$(grep '^Signed-off-by: ' "$1" | 21 | sort | uniq -c | sed -e '/^[ ]*1[ ]/d')" || { 22 | echo >&2 Duplicate Signed-off-by lines. 23 | exit 1 24 | } 25 | -------------------------------------------------------------------------------- /t/data/example-repo/hooks/post-update.sample: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # An example hook script to prepare a packed repository for use over 4 | # dumb transports. 5 | # 6 | # To enable this hook, rename this file to "post-update". 7 | 8 | exec git update-server-info 9 | -------------------------------------------------------------------------------- /t/data/example-repo/hooks/pre-applypatch.sample: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # An example hook script to verify what is about to be committed 4 | # by applypatch from an e-mail message. 5 | # 6 | # The hook should exit with non-zero status after issuing an 7 | # appropriate message if it wants to stop the commit. 8 | # 9 | # To enable this hook, rename this file to "pre-applypatch". 10 | 11 | . git-sh-setup 12 | precommit="$(git rev-parse --git-path hooks/pre-commit)" 13 | test -x "$precommit" && exec "$precommit" ${1+"$@"} 14 | : 15 | -------------------------------------------------------------------------------- /t/data/example-repo/hooks/pre-commit.sample: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # An example hook script to verify what is about to be committed. 4 | # Called by "git commit" with no arguments. The hook should 5 | # exit with non-zero status after issuing an appropriate message if 6 | # it wants to stop the commit. 7 | # 8 | # To enable this hook, rename this file to "pre-commit". 9 | 10 | if git rev-parse --verify HEAD >/dev/null 2>&1 11 | then 12 | against=HEAD 13 | else 14 | # Initial commit: diff against an empty tree object 15 | against=4b825dc642cb6eb9a060e54bf8d69288fbee4904 16 | fi 17 | 18 | # If you want to allow non-ASCII filenames set this variable to true. 19 | allownonascii=$(git config --bool hooks.allownonascii) 20 | 21 | # Redirect output to stderr. 22 | exec 1>&2 23 | 24 | # Cross platform projects tend to avoid non-ASCII filenames; prevent 25 | # them from being added to the repository. We exploit the fact that the 26 | # printable range starts at the space character and ends with tilde. 27 | if [ "$allownonascii" != "true" ] && 28 | # Note that the use of brackets around a tr range is ok here, (it's 29 | # even required, for portability to Solaris 10's /usr/bin/tr), since 30 | # the square bracket bytes happen to fall in the designated range. 31 | test $(git diff --cached --name-only --diff-filter=A -z $against | 32 | LC_ALL=C tr -d '[ -~]\0' | wc -c) != 0 33 | then 34 | cat <<\EOF 35 | Error: Attempt to add a non-ASCII file name. 36 | 37 | This can cause problems if you want to work with people on other platforms. 38 | 39 | To be portable it is advisable to rename the file. 40 | 41 | If you know what you are doing you can disable this check using: 42 | 43 | git config hooks.allownonascii true 44 | EOF 45 | exit 1 46 | fi 47 | 48 | # If there are whitespace errors, print the offending file names and fail. 49 | exec git diff-index --check --cached $against -- 50 | -------------------------------------------------------------------------------- /t/data/example-repo/hooks/pre-push.sample: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # An example hook script to verify what is about to be pushed. Called by "git 4 | # push" after it has checked the remote status, but before anything has been 5 | # pushed. If this script exits with a non-zero status nothing will be pushed. 6 | # 7 | # This hook is called with the following parameters: 8 | # 9 | # $1 -- Name of the remote to which the push is being done 10 | # $2 -- URL to which the push is being done 11 | # 12 | # If pushing without using a named remote those arguments will be equal. 13 | # 14 | # Information about the commits which are being pushed is supplied as lines to 15 | # the standard input in the form: 16 | # 17 | # 18 | # 19 | # This sample shows how to prevent push of commits where the log message starts 20 | # with "WIP" (work in progress). 21 | 22 | remote="$1" 23 | url="$2" 24 | 25 | z40=0000000000000000000000000000000000000000 26 | 27 | while read local_ref local_sha remote_ref remote_sha 28 | do 29 | if [ "$local_sha" = $z40 ] 30 | then 31 | # Handle delete 32 | : 33 | else 34 | if [ "$remote_sha" = $z40 ] 35 | then 36 | # New branch, examine all commits 37 | range="$local_sha" 38 | else 39 | # Update to existing branch, examine new commits 40 | range="$remote_sha..$local_sha" 41 | fi 42 | 43 | # Check for WIP commit 44 | commit=`git rev-list -n 1 --grep '^WIP' "$range"` 45 | if [ -n "$commit" ] 46 | then 47 | echo >&2 "Found WIP commit in $local_ref, not pushing" 48 | exit 1 49 | fi 50 | fi 51 | done 52 | 53 | exit 0 54 | -------------------------------------------------------------------------------- /t/data/example-repo/hooks/pre-rebase.sample: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # Copyright (c) 2006, 2008 Junio C Hamano 4 | # 5 | # The "pre-rebase" hook is run just before "git rebase" starts doing 6 | # its job, and can prevent the command from running by exiting with 7 | # non-zero status. 8 | # 9 | # The hook is called with the following parameters: 10 | # 11 | # $1 -- the upstream the series was forked from. 12 | # $2 -- the branch being rebased (or empty when rebasing the current branch). 13 | # 14 | # This sample shows how to prevent topic branches that are already 15 | # merged to 'next' branch from getting rebased, because allowing it 16 | # would result in rebasing already published history. 17 | 18 | publish=next 19 | basebranch="$1" 20 | if test "$#" = 2 21 | then 22 | topic="refs/heads/$2" 23 | else 24 | topic=`git symbolic-ref HEAD` || 25 | exit 0 ;# we do not interrupt rebasing detached HEAD 26 | fi 27 | 28 | case "$topic" in 29 | refs/heads/??/*) 30 | ;; 31 | *) 32 | exit 0 ;# we do not interrupt others. 33 | ;; 34 | esac 35 | 36 | # Now we are dealing with a topic branch being rebased 37 | # on top of master. Is it OK to rebase it? 38 | 39 | # Does the topic really exist? 40 | git show-ref -q "$topic" || { 41 | echo >&2 "No such branch $topic" 42 | exit 1 43 | } 44 | 45 | # Is topic fully merged to master? 46 | not_in_master=`git rev-list --pretty=oneline ^master "$topic"` 47 | if test -z "$not_in_master" 48 | then 49 | echo >&2 "$topic is fully merged to master; better remove it." 50 | exit 1 ;# we could allow it, but there is no point. 51 | fi 52 | 53 | # Is topic ever merged to next? If so you should not be rebasing it. 54 | only_next_1=`git rev-list ^master "^$topic" ${publish} | sort` 55 | only_next_2=`git rev-list ^master ${publish} | sort` 56 | if test "$only_next_1" = "$only_next_2" 57 | then 58 | not_in_topic=`git rev-list "^$topic" master` 59 | if test -z "$not_in_topic" 60 | then 61 | echo >&2 "$topic is already up-to-date with master" 62 | exit 1 ;# we could allow it, but there is no point. 63 | else 64 | exit 0 65 | fi 66 | else 67 | not_in_next=`git rev-list --pretty=oneline ^${publish} "$topic"` 68 | /opt/local/bin/perl5.22 -e ' 69 | my $topic = $ARGV[0]; 70 | my $msg = "* $topic has commits already merged to public branch:\n"; 71 | my (%not_in_next) = map { 72 | /^([0-9a-f]+) /; 73 | ($1 => 1); 74 | } split(/\n/, $ARGV[1]); 75 | for my $elem (map { 76 | /^([0-9a-f]+) (.*)$/; 77 | [$1 => $2]; 78 | } split(/\n/, $ARGV[2])) { 79 | if (!exists $not_in_next{$elem->[0]}) { 80 | if ($msg) { 81 | print STDERR $msg; 82 | undef $msg; 83 | } 84 | print STDERR " $elem->[1]\n"; 85 | } 86 | } 87 | ' "$topic" "$not_in_next" "$not_in_master" 88 | exit 1 89 | fi 90 | 91 | exit 0 92 | 93 | ################################################################ 94 | 95 | This sample hook safeguards topic branches that have been 96 | published from being rewound. 97 | 98 | The workflow assumed here is: 99 | 100 | * Once a topic branch forks from "master", "master" is never 101 | merged into it again (either directly or indirectly). 102 | 103 | * Once a topic branch is fully cooked and merged into "master", 104 | it is deleted. If you need to build on top of it to correct 105 | earlier mistakes, a new topic branch is created by forking at 106 | the tip of the "master". This is not strictly necessary, but 107 | it makes it easier to keep your history simple. 108 | 109 | * Whenever you need to test or publish your changes to topic 110 | branches, merge them into "next" branch. 111 | 112 | The script, being an example, hardcodes the publish branch name 113 | to be "next", but it is trivial to make it configurable via 114 | $GIT_DIR/config mechanism. 115 | 116 | With this workflow, you would want to know: 117 | 118 | (1) ... if a topic branch has ever been merged to "next". Young 119 | topic branches can have stupid mistakes you would rather 120 | clean up before publishing, and things that have not been 121 | merged into other branches can be easily rebased without 122 | affecting other people. But once it is published, you would 123 | not want to rewind it. 124 | 125 | (2) ... if a topic branch has been fully merged to "master". 126 | Then you can delete it. More importantly, you should not 127 | build on top of it -- other people may already want to 128 | change things related to the topic as patches against your 129 | "master", so if you need further changes, it is better to 130 | fork the topic (perhaps with the same name) afresh from the 131 | tip of "master". 132 | 133 | Let's look at this example: 134 | 135 | o---o---o---o---o---o---o---o---o---o "next" 136 | / / / / 137 | / a---a---b A / / 138 | / / / / 139 | / / c---c---c---c B / 140 | / / / \ / 141 | / / / b---b C \ / 142 | / / / / \ / 143 | ---o---o---o---o---o---o---o---o---o---o---o "master" 144 | 145 | 146 | A, B and C are topic branches. 147 | 148 | * A has one fix since it was merged up to "next". 149 | 150 | * B has finished. It has been fully merged up to "master" and "next", 151 | and is ready to be deleted. 152 | 153 | * C has not merged to "next" at all. 154 | 155 | We would want to allow C to be rebased, refuse A, and encourage 156 | B to be deleted. 157 | 158 | To compute (1): 159 | 160 | git rev-list ^master ^topic next 161 | git rev-list ^master next 162 | 163 | if these match, topic has not merged in next at all. 164 | 165 | To compute (2): 166 | 167 | git rev-list master..topic 168 | 169 | if this is empty, it is fully merged to "master". 170 | -------------------------------------------------------------------------------- /t/data/example-repo/hooks/prepare-commit-msg.sample: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # An example hook script to prepare the commit log message. 4 | # Called by "git commit" with the name of the file that has the 5 | # commit message, followed by the description of the commit 6 | # message's source. The hook's purpose is to edit the commit 7 | # message file. If the hook fails with a non-zero status, 8 | # the commit is aborted. 9 | # 10 | # To enable this hook, rename this file to "prepare-commit-msg". 11 | 12 | # This hook includes three examples. The first comments out the 13 | # "Conflicts:" part of a merge commit. 14 | # 15 | # The second includes the output of "git diff --name-status -r" 16 | # into the message, just before the "git status" output. It is 17 | # commented because it doesn't cope with --amend or with squashed 18 | # commits. 19 | # 20 | # The third example adds a Signed-off-by line to the message, that can 21 | # still be edited. This is rarely a good idea. 22 | 23 | case "$2,$3" in 24 | merge,) 25 | /opt/local/bin/perl5.22 -i.bak -ne 's/^/# /, s/^# #/#/ if /^Conflicts/ .. /#/; print' "$1" ;; 26 | 27 | # ,|template,) 28 | # /opt/local/bin/perl5.22 -i.bak -pe ' 29 | # print "\n" . `git diff --cached --name-status -r` 30 | # if /^#/ && $first++ == 0' "$1" ;; 31 | 32 | *) ;; 33 | esac 34 | 35 | # SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p') 36 | # grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1" 37 | -------------------------------------------------------------------------------- /t/data/example-repo/hooks/update.sample: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # An example hook script to block unannotated tags from entering. 4 | # Called by "git receive-pack" with arguments: refname sha1-old sha1-new 5 | # 6 | # To enable this hook, rename this file to "update". 7 | # 8 | # Config 9 | # ------ 10 | # hooks.allowunannotated 11 | # This boolean sets whether unannotated tags will be allowed into the 12 | # repository. By default they won't be. 13 | # hooks.allowdeletetag 14 | # This boolean sets whether deleting tags will be allowed in the 15 | # repository. By default they won't be. 16 | # hooks.allowmodifytag 17 | # This boolean sets whether a tag may be modified after creation. By default 18 | # it won't be. 19 | # hooks.allowdeletebranch 20 | # This boolean sets whether deleting branches will be allowed in the 21 | # repository. By default they won't be. 22 | # hooks.denycreatebranch 23 | # This boolean sets whether remotely creating branches will be denied 24 | # in the repository. By default this is allowed. 25 | # 26 | 27 | # --- Command line 28 | refname="$1" 29 | oldrev="$2" 30 | newrev="$3" 31 | 32 | # --- Safety check 33 | if [ -z "$GIT_DIR" ]; then 34 | echo "Don't run this script from the command line." >&2 35 | echo " (if you want, you could supply GIT_DIR then run" >&2 36 | echo " $0 )" >&2 37 | exit 1 38 | fi 39 | 40 | if [ -z "$refname" -o -z "$oldrev" -o -z "$newrev" ]; then 41 | echo "usage: $0 " >&2 42 | exit 1 43 | fi 44 | 45 | # --- Config 46 | allowunannotated=$(git config --bool hooks.allowunannotated) 47 | allowdeletebranch=$(git config --bool hooks.allowdeletebranch) 48 | denycreatebranch=$(git config --bool hooks.denycreatebranch) 49 | allowdeletetag=$(git config --bool hooks.allowdeletetag) 50 | allowmodifytag=$(git config --bool hooks.allowmodifytag) 51 | 52 | # check for no description 53 | projectdesc=$(sed -e '1q' "$GIT_DIR/description") 54 | case "$projectdesc" in 55 | "Unnamed repository"* | "") 56 | echo "*** Project description file hasn't been set" >&2 57 | exit 1 58 | ;; 59 | esac 60 | 61 | # --- Check types 62 | # if $newrev is 0000...0000, it's a commit to delete a ref. 63 | zero="0000000000000000000000000000000000000000" 64 | if [ "$newrev" = "$zero" ]; then 65 | newrev_type=delete 66 | else 67 | newrev_type=$(git cat-file -t $newrev) 68 | fi 69 | 70 | case "$refname","$newrev_type" in 71 | refs/tags/*,commit) 72 | # un-annotated tag 73 | short_refname=${refname##refs/tags/} 74 | if [ "$allowunannotated" != "true" ]; then 75 | echo "*** The un-annotated tag, $short_refname, is not allowed in this repository" >&2 76 | echo "*** Use 'git tag [ -a | -s ]' for tags you want to propagate." >&2 77 | exit 1 78 | fi 79 | ;; 80 | refs/tags/*,delete) 81 | # delete tag 82 | if [ "$allowdeletetag" != "true" ]; then 83 | echo "*** Deleting a tag is not allowed in this repository" >&2 84 | exit 1 85 | fi 86 | ;; 87 | refs/tags/*,tag) 88 | # annotated tag 89 | if [ "$allowmodifytag" != "true" ] && git rev-parse $refname > /dev/null 2>&1 90 | then 91 | echo "*** Tag '$refname' already exists." >&2 92 | echo "*** Modifying a tag is not allowed in this repository." >&2 93 | exit 1 94 | fi 95 | ;; 96 | refs/heads/*,commit) 97 | # branch 98 | if [ "$oldrev" = "$zero" -a "$denycreatebranch" = "true" ]; then 99 | echo "*** Creating a branch is not allowed in this repository" >&2 100 | exit 1 101 | fi 102 | ;; 103 | refs/heads/*,delete) 104 | # delete branch 105 | if [ "$allowdeletebranch" != "true" ]; then 106 | echo "*** Deleting a branch is not allowed in this repository" >&2 107 | exit 1 108 | fi 109 | ;; 110 | refs/remotes/*,commit) 111 | # tracking branch 112 | ;; 113 | refs/remotes/*,delete) 114 | # delete tracking branch 115 | if [ "$allowdeletebranch" != "true" ]; then 116 | echo "*** Deleting a tracking branch is not allowed in this repository" >&2 117 | exit 1 118 | fi 119 | ;; 120 | *) 121 | # Anything else (is there anything else?) 122 | echo "*** Update hook: unknown type of update to ref $refname of type $newrev_type" >&2 123 | exit 1 124 | ;; 125 | esac 126 | 127 | # --- Finished 128 | exit 0 129 | -------------------------------------------------------------------------------- /t/data/example-repo/index: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/example-repo/index -------------------------------------------------------------------------------- /t/data/example-repo/info/exclude: -------------------------------------------------------------------------------- 1 | # git ls-files --others --exclude-from=.git/info/exclude 2 | # Lines that start with '#' are comments. 3 | # For a project mostly in C, the following would be a good set of 4 | # exclude patterns (uncomment them if you want to use them): 5 | # *.[oa] 6 | # *~ 7 | -------------------------------------------------------------------------------- /t/data/example-repo/info/refs: -------------------------------------------------------------------------------- 1 | cb96e53d08dbfc0d358c5f312029aecaf584a390 refs/heads/master 2 | -------------------------------------------------------------------------------- /t/data/example-repo/logs/HEAD: -------------------------------------------------------------------------------- 1 | 0000000000000000000000000000000000000000 0ec3337eede3a64aaed50f737adf163e9f8d92dc Alexey Veretennikov 1478720034 +0100 commit (initial): Initial import 2 | 0ec3337eede3a64aaed50f737adf163e9f8d92dc a2194f882da560df01357af06a4a7cc91614ee94 Alexey Veretennikov 1478720122 +0100 commit: Changed text 3 | a2194f882da560df01357af06a4a7cc91614ee94 cb96e53d08dbfc0d358c5f312029aecaf584a390 Alexey Veretennikov 1478720297 +0100 commit: Added another file 4 | cb96e53d08dbfc0d358c5f312029aecaf584a390 0ec3337eede3a64aaed50f737adf163e9f8d92dc Alexey Veretennikov 1478720689 +0100 checkout: moving from master to HEAD~2 5 | 0ec3337eede3a64aaed50f737adf163e9f8d92dc cb96e53d08dbfc0d358c5f312029aecaf584a390 Alexey Veretennikov 1478720715 +0100 checkout: moving from 0ec3337eede3a64aaed50f737adf163e9f8d92dc to master 6 | cb96e53d08dbfc0d358c5f312029aecaf584a390 a2194f882da560df01357af06a4a7cc91614ee94 Alexey Veretennikov 1478720722 +0100 checkout: moving from master to HEAD~1 7 | a2194f882da560df01357af06a4a7cc91614ee94 cb96e53d08dbfc0d358c5f312029aecaf584a390 Alexey Veretennikov 1478720731 +0100 checkout: moving from a2194f882da560df01357af06a4a7cc91614ee94 to master 8 | -------------------------------------------------------------------------------- /t/data/example-repo/logs/refs/heads/master: -------------------------------------------------------------------------------- 1 | 0000000000000000000000000000000000000000 0ec3337eede3a64aaed50f737adf163e9f8d92dc Alexey Veretennikov 1478720034 +0100 commit (initial): Initial import 2 | 0ec3337eede3a64aaed50f737adf163e9f8d92dc a2194f882da560df01357af06a4a7cc91614ee94 Alexey Veretennikov 1478720122 +0100 commit: Changed text 3 | a2194f882da560df01357af06a4a7cc91614ee94 cb96e53d08dbfc0d358c5f312029aecaf584a390 Alexey Veretennikov 1478720297 +0100 commit: Added another file 4 | -------------------------------------------------------------------------------- /t/data/example-repo/objects/info/packs: -------------------------------------------------------------------------------- 1 | P pack-559f5160ab63a074f365f538d209164b5d8a715a.pack 2 | 3 | -------------------------------------------------------------------------------- /t/data/example-repo/objects/pack/pack-559f5160ab63a074f365f538d209164b5d8a715a.idx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/example-repo/objects/pack/pack-559f5160ab63a074f365f538d209164b5d8a715a.idx -------------------------------------------------------------------------------- /t/data/example-repo/objects/pack/pack-559f5160ab63a074f365f538d209164b5d8a715a.pack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/example-repo/objects/pack/pack-559f5160ab63a074f365f538d209164b5d8a715a.pack -------------------------------------------------------------------------------- /t/data/example-repo/packed-refs: -------------------------------------------------------------------------------- 1 | # pack-refs with: peeled fully-peeled 2 | cb96e53d08dbfc0d358c5f312029aecaf584a390 refs/heads/master 3 | -------------------------------------------------------------------------------- /t/data/example-repo/refs/heads/.empty: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/example-repo/refs/heads/.empty -------------------------------------------------------------------------------- /t/data/example-repo/refs/tags/.empty: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/example-repo/refs/tags/.empty -------------------------------------------------------------------------------- /t/data/git-commit.compressed: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/git-commit.compressed -------------------------------------------------------------------------------- /t/data/git-commit.uncompressed: -------------------------------------------------------------------------------- 1 | commit 362tree 79954e4f2f7c840dbf675034b2808b6124275da1 2 | parent bbed6ce31121883edad27ee3b43c22373bc90d7c 3 | author Alexey Veretennikov 1573388944 +0100 4 | committer Alexey Veretennikov 1573388944 +0100 5 | 6 | Introduced git-api package for API 7 | 8 | Updated README and added new package git-api which 9 | will contain common APIs 10 | -------------------------------------------------------------------------------- /t/data/readoneline.txt: -------------------------------------------------------------------------------- 1 | A test of one line reading from the file. 2 | The rest should not be read. 3 | -------------------------------------------------------------------------------- /t/data/test.idx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/test.idx -------------------------------------------------------------------------------- /t/data/test.pack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fourier/git-api/7c030024838abbcc0fbcd3735065836d3244bec9/t/data/test.pack -------------------------------------------------------------------------------- /t/data/test_idx.sexp: -------------------------------------------------------------------------------- 1 | 2 | #((12 3 | . #(187 29 69 102 221 231 198 144 126 55 50 253 125 251 211 86 201 4 | 113 127 50)) 5 | (199 6 | . #(62 208 210 114 96 153 167 51 151 46 172 86 178 239 21 142 97 49 7 | 224 123)) 8 | (374 9 | . #(1 57 34 245 168 44 134 148 143 211 39 98 174 180 19 173 224 176 10 | 15 59)) 11 | (549 12 | . #(165 30 204 108 56 108 17 140 247 148 186 123 228 230 219 194 70 13 | 165 16 85)) 14 | (731 15 | . #(81 198 37 32 160 20 218 100 37 13 247 193 113 187 42 104 190 157 16 | 132 99)) 17 | (943 18 | . #(102 42 190 246 163 208 86 68 233 34 134 210 13 76 15 193 9 242 19 | 143 233)) 20 | (1079 21 | . #(238 104 164 0 98 45 226 53 209 250 247 113 172 173 233 234 69 22 | 213 131 106)) 23 | (1332 24 | . #(196 82 187 45 138 51 210 191 141 103 185 216 192 104 92 209 10 25 | 177 213 252)) 26 | (1401 27 | . #(101 197 202 136 166 124 48 190 206 224 28 90 136 22 217 100 176 28 | 56 98 249)) 29 | (4027 30 | . #(191 223 244 64 234 159 98 15 177 40 199 55 206 243 187 88 177 31 | 143 25 248)) 32 | (4929 33 | . #(107 247 48 216 70 211 100 242 114 180 121 213 25 28 147 67 72 79 34 | 102 16)) 35 | (4957 36 | . #(11 196 142 148 144 70 25 6 233 212 200 24 254 52 112 150 55 102 37 | 188 108)) 38 | (5418 39 | . #(138 90 83 36 123 48 111 141 28 28 125 233 25 27 73 229 232 205 40 | 208 142)) 41 | (8211 42 | . #(43 146 74 206 124 9 251 61 50 105 91 150 252 172 53 79 98 211 20 43 | 240)) 44 | (8235 45 | . #(95 250 229 185 113 180 157 31 12 22 73 94 81 134 229 241 178 133 46 | 45 84)) 47 | (9334 48 | . #(233 214 50 115 151 228 32 110 179 172 172 164 64 55 247 46 133 49 | 245 221 23)) 50 | (9357 51 | . #(3 127 245 191 92 33 39 238 38 117 41 94 2 145 46 237 98 64 165 52 | 2)) 53 | (9651 54 | . #(102 161 158 48 225 165 198 175 82 186 98 69 6 139 56 32 240 255 55 | 5 165)) 56 | (9673 57 | . #(210 6 29 111 146 170 10 220 71 229 186 115 172 228 238 110 96 62 58 | 87 242)) 59 | (2877300 60 | . #(65 169 213 96 119 79 195 140 208 237 74 50 87 153 231 51 58 48 61 | 151 48)) 62 | (2877587 63 | . #(32 173 162 73 73 171 172 101 9 38 219 23 35 45 65 4 252 201 9 64 | 250)) 65 | (2877809 66 | . #(189 202 26 18 149 149 122 4 33 233 35 202 44 76 97 102 221 93 83 67 | 59)) 68 | (2877832 69 | . #(227 82 182 99 23 122 35 189 193 116 227 236 72 110 41 167 180 50 70 | 218 119)) 71 | (2878084 72 | . #(9 71 193 103 0 105 152 154 145 23 72 17 58 30 1 240 109 132 207 73 | 124)) 74 | (2878109 75 | . #(82 121 126 225 32 225 224 194 185 200 28 188 148 215 144 251 81 76 | 171 205 253)) 77 | (2878330 78 | . #(203 128 149 194 95 30 47 236 129 56 205 30 33 133 55 247 61 148 79 | 254 249)) 80 | (2878352 81 | . #(238 28 119 28 96 56 69 51 235 77 140 78 52 148 246 134 87 124 82 | 197 129)) 83 | (2878374 84 | . #(143 78 76 179 177 235 216 140 123 1 218 232 87 27 125 141 138 47 85 | 244 19)) 86 | (2878394 87 | . #(145 121 249 204 51 75 130 63 176 168 218 123 174 184 111 242 12 88 | 142 99 128)) 89 | (2878657 90 | . #(253 52 72 254 52 247 128 72 49 190 116 137 97 228 16 222 228 128 91 | 60 186)) 92 | (2878675 93 | . #(203 212 23 239 64 244 60 222 122 100 110 18 214 4 96 230 42 143 94 | 60 44)) 95 | (2878898 96 | . #(198 210 148 168 24 205 192 85 168 52 228 52 179 47 219 207 200 97 | 117 131 252)) 98 | (2878955 99 | . #(229 105 100 62 204 107 230 45 95 189 134 22 217 251 211 58 215 100 | 135 244 154)) 101 | (2879293 102 | . #(193 92 180 153 157 195 235 11 62 33 180 116 96 25 159 227 87 99 103 | 158 42)) 104 | (2879392 105 | . #(98 163 67 52 182 119 33 170 153 123 205 116 204 210 182 17 153 106 | 179 16 110)) 107 | (2879623 108 | . #(134 58 112 117 70 189 161 169 201 187 73 206 247 249 89 193 94 109 | 67 38 229)) 110 | (2879759 111 | . #(52 9 224 153 83 160 149 141 38 64 146 171 47 5 66 159 198 47 243 112 | 158)) 113 | (2879976 114 | . #(149 188 6 66 22 193 82 190 142 28 220 16 72 236 95 3 43 186 214 115 | 89)) 116 | (2880082 117 | . #(220 30 161 248 82 31 38 47 116 186 235 70 208 201 6 115 109 128 118 | 76 27))) -------------------------------------------------------------------------------- /t/filemasks-test.lisp: -------------------------------------------------------------------------------- 1 | ;;;; filemasks-test.lisp 2 | ;; NOTE: To run this test file, execute `(asdf:test-system :git-api)' in your Lisp. 3 | ;; 4 | 5 | (in-package :cl-user) 6 | (defpackage git-api.test.filemasks-test 7 | (:use :cl 8 | :git-api.utils 9 | :git-api.test.base 10 | :git-api.plumbing.helpers.details.filemasks 11 | :prove)) 12 | (in-package :git-api.test.filemasks-test) 13 | 14 | (plan nil) 15 | 16 | (subtest "Testing wildcard-to-regex" 17 | (is (wildcard-to-regex "Photo*.jpg") 18 | "^Photo.*\\.jpg$" 19 | "Testing input: Photo*.jpg") 20 | (is (wildcard-to-regex "Photo*.jpg" :case-sensitive-p nil) 21 | "(?i)^Photo.*\\.jpg$" 22 | "Testing input: Photo*.jpg case-insensitive") 23 | (is (wildcard-to-regex "Photo[.jpg" :case-sensitive-p nil) 24 | "(?i)^Photo\\[\\.jpg$" 25 | "Testing input: Photo[*.jpg case-insensitive") 26 | (is (wildcard-to-regex "Photo[ab].jpg" :case-sensitive-p nil) 27 | "(?i)^Photo[ab]\\.jpg$" 28 | "Testing input: Photo[ab].jpg") 29 | (is (wildcard-to-regex "Photo[!ab].jpg" :case-sensitive-p nil) 30 | "(?i)^Photo[^ab]\\.jpg$" 31 | "Testing input: Photo[!ab].jpg") 32 | (is (wildcard-to-regex "Photo[^ab].jpg" :case-sensitive-p nil) 33 | "(?i)^Photo[\\^ab]\\.jpg$" 34 | "Testing input: Photo[^ab].jpg")) 35 | 36 | 37 | 38 | 39 | (finalize) 40 | -------------------------------------------------------------------------------- /t/object-test.lisp: -------------------------------------------------------------------------------- 1 | ;;;; object-test.lisp 2 | ;; NOTE: To run this test file, execute `(asdf:test-system :git-api)' in your Lisp. 3 | ;; 4 | 5 | (in-package :cl-user) 6 | (defpackage git-api.test.object-test 7 | (:use :cl 8 | :alexandria 9 | :git-api.test.base 10 | :git-api.utils 11 | :git-api.object 12 | :prove)) 13 | 14 | (in-package git-api.test.object-test) 15 | 16 | ;; import unexterned(private for package) functions 17 | (from nibbles import write-ub64/be write-ub32/be) 18 | (from git-api.utils import sha1-to-hex) 19 | 20 | (from git-api.object import parse-tree-entry parse-text-git-data find-consecutive-newlines) 21 | 22 | (defparameter +newlines+ (coerce '(#\newline #\newline) 'string)) 23 | 24 | (defparameter +tag-object-hash+ "f883596e997fe5bcbc5e89bee01b869721326109") 25 | (defparameter +tag-object-size+ 960) 26 | (defparameter +tag-object-data+ 27 | (make-array 1024 :element-type '(unsigned-byte 8) :initial-contents 28 | '(111 98 106 101 99 116 32 101 48 99 49 99 101 97 102 99 53 98 101 99 101 57 29 | 50 100 51 53 55 55 51 97 55 53 102 102 102 53 57 52 57 55 101 49 100 57 30 | 98 100 53 10 116 121 112 101 32 99 111 109 109 105 116 10 116 97 103 32 118 50 31 | 46 57 46 51 10 116 97 103 103 101 114 32 74 117 110 105 111 32 67 32 72 97 32 | 109 97 110 111 32 60 103 105 116 115 116 101 114 64 112 111 98 111 120 46 99 111 33 | 109 62 32 49 52 55 49 48 49 56 54 55 57 32 45 48 55 48 48 10 10 71 34 | 105 116 32 50 46 57 46 51 10 45 45 45 45 45 66 69 71 73 78 32 80 71 35 | 80 32 83 73 71 78 65 84 85 82 69 45 45 45 45 45 10 86 101 114 115 105 36 | 111 110 58 32 71 110 117 80 71 32 118 49 10 10 105 81 73 99 66 65 65 66 37 | 65 103 65 71 66 81 74 88 114 102 97 51 65 65 111 74 69 76 67 49 54 73 38 | 97 87 114 43 98 76 76 89 56 81 65 78 69 56 90 97 76 43 113 121 104 106 39 | 67 56 102 72 102 74 104 104 114 52 99 89 10 71 101 90 101 56 120 57 83 83 40 | 84 78 118 48 87 122 79 118 88 71 102 51 52 88 119 100 112 79 89 89 105 86 41 | 114 85 114 119 108 103 66 120 54 72 103 108 104 68 101 89 122 67 112 52 107 79 42 | 98 82 53 115 72 119 116 84 75 103 78 10 114 48 75 75 118 65 117 118 106 108 43 | 90 74 109 53 116 87 78 97 118 117 50 102 68 111 72 75 104 69 43 81 82 80 44 | 51 65 97 103 97 70 53 105 68 88 54 56 81 76 106 104 71 79 83 56 43 122 45 | 65 87 113 78 82 117 107 104 55 121 10 88 54 116 109 100 85 104 71 104 87 80 46 | 116 85 75 114 49 76 66 85 86 100 57 52 71 100 70 56 118 53 116 103 103 67 47 | 78 68 99 113 90 90 106 43 100 80 73 111 115 80 118 108 68 113 71 87 84 50 48 | 57 47 73 75 121 67 85 47 97 10 52 111 57 49 104 68 53 106 87 107 77 121 49 | 98 102 121 84 119 122 90 68 115 83 89 109 116 66 52 84 88 120 77 76 56 105 50 | 100 74 85 100 90 81 53 76 121 121 80 113 57 117 83 85 54 51 108 103 80 56 51 | 108 106 119 105 118 89 122 121 10 111 105 86 66 49 79 79 97 119 121 109 55 43 52 | 80 101 121 118 90 69 118 76 118 112 70 87 49 75 115 55 89 83 84 67 77 78 53 | 81 106 110 52 89 51 100 120 89 70 51 115 122 117 111 80 90 86 51 122 116 67 54 | 122 110 103 111 69 73 71 10 113 83 117 122 65 48 115 110 54 122 102 97 77 87 55 | 65 81 70 50 89 106 105 120 50 122 66 102 83 108 66 88 109 120 78 122 65 47 56 | 87 113 89 65 121 78 114 51 76 115 105 97 115 53 65 47 88 57 110 70 116 111 57 | 119 83 69 105 53 54 10 48 105 70 86 105 108 83 115 75 87 99 51 98 67 48 58 | 111 78 69 121 89 70 108 85 115 49 107 89 52 114 82 50 83 53 107 98 66 88 59 | 84 74 54 108 55 53 98 118 68 118 88 80 47 76 43 74 88 109 52 81 99 82 60 | 67 114 57 50 105 10 54 105 55 78 89 120 101 78 113 102 110 90 90 86 55 50 61 | 75 101 71 50 69 113 90 97 76 52 109 114 88 65 89 54 56 77 106 118 56 106 62 | 100 47 56 48 111 111 103 67 85 68 66 104 108 84 75 100 56 73 75 47 87 71 63 | 54 52 77 57 10 86 106 102 72 112 118 75 109 116 107 66 97 73 113 54 90 122 64 | 48 99 81 120 79 49 112 101 52 70 54 52 71 122 83 78 122 108 67 57 108 55 65 | 56 55 105 81 67 110 85 87 43 52 66 79 55 79 121 69 65 66 121 74 87 122 66 | 72 110 43 10 68 53 111 83 102 87 73 55 57 77 68 86 100 118 119 50 85 108 67 | 72 118 107 49 116 103 52 98 78 78 89 76 99 78 119 84 71 90 71 81 104 99 68 | 119 88 117 100 118 55 104 112 122 87 51 115 49 80 66 78 89 48 76 122 88 71 69 | 117 120 10 76 66 79 100 108 86 101 67 99 115 89 71 114 50 114 115 82 77 98 70 | 109 10 61 80 104 84 73 10 45 45 45 45 45 69 78 68 32 80 71 80 32 83 71 | 73 71 78 65 84 85 82 69 45 45 45 45 45 10 119 117 89 54 50 85 110 86 72 | 47 68 108 100 65 53 70 109 99 83 101 111 117 102 86 101 82 83 113 112 71 100 73 | 65 55 70 72 110 83 111 89 108 57 54 104 53 118 43 67 114 86 43 68 121 66 74 | 10 32 109 72 76 73 104 113 78 86 110 50))) 75 | 76 | (defparameter +simple-commit-object-data+ 77 | #(116 114 101 101 32 56 101 101 55 52 53 49 51 55 99 53 49 57 51 56 49 57 78 | 52 56 55 48 100 57 48 50 99 100 55 52 102 57 98 99 48 98 101 54 49 56 79 | 102 10 97 117 116 104 111 114 32 65 108 101 120 101 121 32 86 101 114 101 116 101 80 | 110 110 105 107 111 118 32 60 97 108 101 120 101 121 46 118 101 114 101 116 101 110 81 | 110 105 107 111 118 64 103 109 97 105 108 46 99 111 109 62 32 49 52 55 56 55 82 | 50 48 48 51 52 32 43 48 49 48 48 10 99 111 109 109 105 116 116 101 114 32 83 | 65 108 101 120 101 121 32 86 101 114 101 116 101 110 110 105 107 111 118 32 60 97 84 | 108 101 120 101 121 46 118 101 114 101 116 101 110 110 105 107 111 118 64 103 109 97 85 | 105 108 46 99 111 109 62 32 49 52 55 56 55 50 48 48 51 52 32 43 48 49 86 | 48 48 10 10 73 110 105 116 105 97 108 32 105 109 112 111 114 116 10)) 87 | 88 | (defparameter +simple-commit-object-hash+ "0ec3337eede3a64aaed50f737adf163e9f8d92dc") 89 | 90 | (defparameter +simple-commit-object-size+ 217) 91 | 92 | 93 | (defparameter +empty-commit-object-data+ 94 | #(99 111 109 109 105 116 32 50 53 48 0 116 114 101 101 32 55 51 52 101 100 100 57 95 | 102 101 56 49 53 102 48 56 98 53 50 53 102 50 51 52 50 97 53 48 98 97 96 | 51 57 100 97 53 97 57 100 51 97 100 10 112 97 114 101 110 116 32 56 52 99 97 | 53 99 49 102 55 52 49 101 100 52 101 55 50 102 102 101 55 102 54 49 53 50 98 | 49 49 49 102 99 52 50 56 56 97 54 51 50 99 98 10 97 117 116 104 111 114 99 | 32 65 108 101 120 101 121 32 86 101 114 101 116 101 110 110 105 107 111 118 32 60 100 | 97 108 101 120 101 121 46 118 101 114 101 116 101 110 110 105 107 111 118 64 103 109 101 | 97 105 108 46 99 111 109 62 32 49 52 55 57 55 53 56 54 50 57 32 43 48 102 | 49 48 48 10 99 111 109 109 105 116 116 101 114 32 65 108 101 120 101 121 32 86 103 | 101 114 101 116 101 110 110 105 107 111 118 32 60 97 108 101 120 101 121 46 118 101 104 | 114 101 116 101 110 110 105 107 111 118 64 103 109 97 105 108 46 99 111 109 62 32 105 | 49 52 55 57 55 53 56 54 50 57 32 43 48 49 48 48 10 10)) 106 | 107 | (defparameter +empty-commit-object-hash+ "26aa178ffc4a43d61373f968a7f36dd642e1724f") 108 | (defparameter +empty-commit-object-size+ 250) 109 | (defparameter +empty-commit-object-start+ 11) 110 | 111 | 112 | (defparameter +tree-data+ 113 | #(49 48 48 54 52 52 32 108 111 114 101 109 95 49 48 112 46 116 120 116 0 158 239 247 106 170 39 142 114 | 146 83 176 16 109 250 182 184 171 38 25 214 149 49 48 48 54 52 52 32 108 111 115 | 114 101 109 95 51 48 48 119 46 116 120 116 0 222 233 93 99 255 152 188 27 30 116 | 246 226 106 231 216 62 180 13 101 61 62 51 101 57 102 56 100 57 50 100 99 10 117 | 97 117 116 104 111 114 32 65 108 101 120 101 121 32 86 101 114 101 116 101 110 110 118 | 105 107 111 118 32 60 97 108 101 120 101 121 46 118 101 114 101 116 101 110 110 105 119 | 107 111 118 64 103 109 97 105 108 46 99 111 109 62 32 49 52 55 56 55 50 48 120 | 49 50 50 32 43 48 49 48 48 10 99 111 109 109 105 116 116 101 114 32 65 108 121 | 101 120 101 121 32 86 101 114 101 116 101 110 110 105 107 111 118 32 60 97 108 101 122 | 120 101 121 46 118 101 114 101 116 101 110 110 105 107 111 118 64 103 109 97 105 108 123 | 46 99 111 109 62 32 49 52 55 56 55 50 48 49 50 50 32 43 48 49 48 48 124 | 10 10 67 104 97 110 103 101 100 32 116 101 120 116 10 32 102 105 108 101 10 101 125 | 114 111 44 32 98 105 98 101 110 100 117 109 32 115 117 115 99 105 112 105 116 32 126 | 116 111 114 116 111 114 32 100 117 105 32 101 116 32 111 114 99 105 46 32 70 117 127 | 115 99 101 32 110 111 110 32 101 120 32 113 117 105 115 32 113 117 97 109 32 102 128 | 97 117 99 105 98 117 115 32 112 114 101 116 105 117 109 46 32 80 104 97 115 101 129 | 108 108 117 115 32 113 117 105 115 32 108 111 114 101 109 32 101 116 32 116 101 108 130 | 108 117 115 32 101 102 102 105 99 105 116 117 114 32 112 104 97 114 101 116 114 97)) 131 | (defparameter +tree-data-size+ 83) 132 | (defparameter +tree-data-hash+ "aca7baf1ea0bc6cc23f92edf55ac2e4ea6586f21") 133 | (defparameter +tree-data-parsed+ 134 | '(("100644" "lorem_10p.txt" "9eeff76aaa278e9253b0106dfab6b8ab2619d695") 135 | ("100644" "lorem_300w.txt" "dee95d63ff98bc1b1ef6e26ae7d83eb40d653d3e"))) 136 | 137 | 138 | (plan nil) 139 | 140 | 141 | (is-type (parse-git-object :tag +tag-object-data+ +tag-object-hash+ :start 0 :size +tag-object-size+) 'git-api.object:tag) 142 | 143 | (subtest "Test parsing of commit without parent" 144 | (let ((commit 145 | (parse-git-object :commit (coerce +simple-commit-object-data+ '(vector (unsigned-byte 8))) 146 | +simple-commit-object-hash+ :start 0 :size +simple-commit-object-size+))) 147 | (is-type commit 'git-api.object:commit "Test if parsed object is the instance of commit class") 148 | (is (object-hash commit) "0ec3337eede3a64aaed50f737adf163e9f8d92dc" :test #'string= 149 | "Test for commit hash") 150 | (is (commit-author commit) "Alexey Veretennikov 1478720034 +0100" 151 | :test #'string= 152 | "Test for commit author") 153 | (is (commit-committer commit) "Alexey Veretennikov 1478720034 +0100" 154 | :test #'string= 155 | "Test for commit committer") 156 | (is (commit-tree commit) "8ee745137c51938194870d902cd74f9bc0be618f" :test #'string= 157 | "Test for commit tree object") 158 | (is (commit-parents commit) nil :test #'equalp 159 | "Test for commit with no parents") 160 | (is (commit-comment commit) (format nil "Initial import~%") :test #'string= 161 | "Test for commit comment"))) 162 | 163 | (subtest "Test parsing of commit with empty comment" 164 | (let ((commit 165 | (parse-git-object :commit (coerce +empty-commit-object-data+ '(vector (unsigned-byte 8))) 166 | +empty-commit-object-hash+ :start +empty-commit-object-start+ :size +empty-commit-object-size+))) 167 | (is-type commit 'git-api.object:commit "Test if parsed object is the instance of commit class") 168 | (is (object-hash commit) "26aa178ffc4a43d61373f968a7f36dd642e1724f" :test #'string= 169 | "Test for commit hash") 170 | (is (commit-author commit) "Alexey Veretennikov 1479758629 +0100" 171 | :test #'string= 172 | "Test for commit author") 173 | (is (commit-committer commit) "Alexey Veretennikov 1479758629 +0100" 174 | :test #'string= 175 | "Test for commit committer") 176 | (is (commit-tree commit) "734edd9fe815f08b525f2342a50ba39da5a9d3ad" :test #'string= 177 | "Test for commit tree object") 178 | (is (commit-parents commit) '("84c5c1f741ed4e72ffe7f6152111fc4288a632cb") :test #'equalp 179 | "Test for parent commit") 180 | (is (commit-comment commit) "" :test #'string= 181 | "Test for commit comment") 182 | ;; test print 183 | (let* ((lines 184 | '("commit: 26aa178ffc4a43d61373f968a7f36dd642e1724f" 185 | "tree 734edd9fe815f08b525f2342a50ba39da5a9d3ad" 186 | "author Alexey Veretennikov 1479758629 +0100" 187 | "committer Alexey Veretennikov 1479758629 +0100" 188 | "parents 84c5c1f741ed4e72ffe7f6152111fc4288a632cb" 189 | "comment")) 190 | (expected (with-output-to-string (s) 191 | (dolist (line lines) (write-line line s))))) 192 | (is-print (format t "~a" commit) expected 193 | "Test of print function of the commit object")))) 194 | 195 | 196 | (subtest "Testing of the parsing of tree objects" 197 | (flet ((compare-entries (entry parsed-entry) 198 | (and (string= (tree-entry-mode entry) (car parsed-entry)) 199 | (string= (tree-entry-name entry) (cadr parsed-entry)) 200 | (string= (tree-entry-hash entry) (caddr parsed-entry))))) 201 | (let ((tree 202 | (parse-git-object :tree (coerce +tree-data+ '(vector (unsigned-byte 8))) 203 | +tree-data-hash+ :start 0 :size +tree-data-size+))) 204 | (is-type tree 'git-api.object:tree "Test if parsed object is the instance of tree class") 205 | (is-type (tree-entries tree) 'list "Test if tree entries are not null") 206 | (is (length (tree-entries tree)) 2 "Test the number of tree entries") 207 | (loop for entry in (tree-entries tree) 208 | for parsed-entry in +tree-data-parsed+ 209 | for i = 1 then (incf i) 210 | do 211 | (is entry parsed-entry :test #'compare-entries (format nil "Compare tree entry ~d" i)))))) 212 | 213 | 214 | (subtest "Testing of parse-tree-entry" 215 | (let* ((mode "100100") 216 | (fname "mycoolfile.txt") 217 | (header (babel:string-to-octets (concatenate 'string mode " " fname))) 218 | (hash #(49 48 48 54 52 52 32 108 111 114 101 109 95 49 48 112 46 116 120 116 )) 219 | ;; create an entry with some initial bytes 220 | (entry (coerce (concatenate 'vector #(1 2 3) header #(0) hash) '(vector (unsigned-byte 8))))) 221 | (let ((parsed-entry (parse-tree-entry entry 3))) 222 | (is-type parsed-entry 'cons "Check if parsed entry result is a cons") 223 | (is-type (car parsed-entry) 'git-api.object::tree-entry "Check if a parsed entry is has a proper type") 224 | (is (tree-entry-hash (car parsed-entry)) (sha1-to-hex hash) :test #'string= "Check hash") 225 | (is (tree-entry-mode (car parsed-entry)) mode :test #'string= "Check mode") 226 | (is (tree-entry-name (car parsed-entry)) fname :test #'string= "Check name") 227 | (is (cdr parsed-entry) (length entry) 228 | "Check the position of the next tree entry is correct")))) 229 | 230 | 231 | (subtest "Testing of find-consecutive-newlines" 232 | (let* ((normal-case 233 | (concatenate 'string "123456" +newlines+ "abcd")) 234 | (no-newlines "123456abcd") 235 | (one-newline-at-end (concatenate 'string "123456" #(#\newline))) 236 | (newlines-at-end (concatenate 'string "123456" +newlines+)) 237 | (newlines-at-beginning (concatenate 'string +newlines+ "123456"))) 238 | (is (find-consecutive-newlines normal-case) 6 "Check if newlines found") 239 | (is (find-consecutive-newlines normal-case :first 2) 6 "Check if newlines with nonzero start") 240 | (is (find-consecutive-newlines normal-case :first 1 :last 5) 5 "Check if newlines with notzero end") 241 | (is (find-consecutive-newlines no-newlines) (length no-newlines) "Check no newlines return length of the string") 242 | (is (find-consecutive-newlines no-newlines :first 2) (length no-newlines) "Check no newlines in shifed string") 243 | (is (find-consecutive-newlines one-newline-at-end) (length one-newline-at-end) "Check when only one newline at the end") 244 | (is (find-consecutive-newlines newlines-at-beginning) 0 "Check when only one newline at the beginning") 245 | (is (find-consecutive-newlines newlines-at-end) (- (length newlines-at-end) 2) "Check when only one newline at the beginning") 246 | (is (find-consecutive-newlines newlines-at-beginning :first 20 :last 20) 20 "Check when first = last"))) 247 | 248 | 249 | 250 | (subtest "Testing of parse-text-git-data" 251 | (let* ((header (concatenate 'string "aaaline1" #(#\newline) "line2")) 252 | (comment1 "hello") 253 | (comment2 "") 254 | (comment3 (concatenate 'string "comment" #(#\newline)))) 255 | (let* ((data1 (babel:string-to-octets (concatenate 'string header +newlines+ comment1))) 256 | (parsed1 (parse-text-git-data data1 3 (- (length data1) 3)))) 257 | (is (caar parsed1) "line1" :test #'string= "Test of the header line 1") 258 | (is (cadar parsed1) "line2" :test #'string= "Test of the header line 2") 259 | (is (cdr parsed1) comment1 :test #'string= "Test of comment 1")) 260 | (let* ((data2 (babel:string-to-octets (concatenate 'string header +newlines+ comment2))) 261 | (parsed2 (parse-text-git-data data2 3 (- (length data2) 3)))) 262 | (is (caar parsed2) "line1" :test #'string= "Test of the header line 1") 263 | (is (cadar parsed2) "line2" :test #'string= "Test of the header line 2") 264 | (is (cdr parsed2) comment2 :test #'string= "Test of comment 2")) 265 | (let* ((data3 (babel:string-to-octets (concatenate 'string header +newlines+ comment3))) 266 | (parsed3 (parse-text-git-data data3 3 (- (length data3) 3)))) 267 | (is (caar parsed3) "line1" :test #'string= "Test of the header line 1") 268 | (is (cadar parsed3) "line2" :test #'string= "Test of the header line 2") 269 | (is (cdr parsed3) comment3 :test #'string= "Test of comment 3")))) 270 | 271 | 272 | 273 | (subtest "Testing of parse-git-file" 274 | (let ((parsed1 275 | (parse-git-file (namestring (testfile "example-objects/52/00e67faf9a9a39b916f7779fe98bcaa47eda0c")))) 276 | (parsed2 277 | (parse-git-file (namestring (testfile "example-objects/52/4acfffa760fd0b8c1de7cf001f8dd348b399d8"))))) 278 | (is-type parsed1 'git-api.object::commit "Check the parsed commit type") 279 | (is-type 280 | (parse-git-file (testfile "example-objects/52/00e67faf9a9a39b916f7779fe98bcaa47eda0c")) 281 | 'git-api.object::commit "Check the parsed commit type with a name as pathname") 282 | (is-type parsed2 'git-api.object::blob "Check the parsed blob type") 283 | (print parsed2) 284 | (is (babel:octets-to-string (blob-content parsed2) ) (concatenate 'string "Test file" '(#\newline)) 285 | :test #'string= "Test of the blob file contents"))) 286 | 287 | 288 | 289 | (finalize) 290 | -------------------------------------------------------------------------------- /t/pack-test.lisp: -------------------------------------------------------------------------------- 1 | ;;;; pack-test.lisp 2 | ;; NOTE: To run this test file, execute `(asdf:test-system :git-api)' in your Lisp. 3 | ;; 4 | 5 | (in-package :cl-user) 6 | (defpackage git-api.test.pack-test 7 | (:use :cl 8 | :alexandria 9 | :git-api.test.base 10 | :git-api.utils 11 | :git-api.pack 12 | :prove)) 13 | 14 | (in-package git-api.test.pack-test) 15 | 16 | ;; import unexterned(private for package) functions 17 | (from nibbles import write-ub64/be write-ub32/be) 18 | (from git-api.pack import read-network-vli read-delta-vli) 19 | (from git-api.pack import read-pack-entry-header) 20 | (from git-api.pack import parse-index-file) 21 | (from git-api.pack import 22 | pack-filename-to-index 23 | index-filename-to-pack 24 | incorrect-file-name-error 25 | corrupted-index-file-error 26 | corrupted-pack-file-error) 27 | (from git-api.pack import read-offsets read-fanout-table) 28 | ;; deltas 29 | (from git-api.pack import decode-delta-copy-cmd apply-delta) 30 | ;; object constants 31 | (from git-api.pack import +obj-commit+ +obj-tag+ +obj-tree+ +obj-blob+) 32 | ;; pack file itself 33 | (from git-api.pack import create-pack-entries-table-initial) 34 | ;; aux function 35 | (from git-api.utils import sha1-to-hex) 36 | ;; pack-entry related 37 | (from git-api.pack import 38 | pack-entry 39 | pack-entry-delta 40 | pack-entry-offset 41 | pack-entry-data-offset 42 | pack-entry-compressed-size 43 | pack-entry-uncompressed-size 44 | pack-entry-type 45 | pack-entry-base-hash) 46 | ;; pack-file related 47 | (from git-api.pack import 48 | pack-file 49 | pack-filename 50 | pack-stream 51 | index-table 52 | offsets-table 53 | pack-open-stream 54 | pack-close-stream 55 | create-indexes-from-pack-file) 56 | 57 | 58 | (defparameter +network-vli-tests+ 59 | '((240 128 112) 60 | (306 129 50) 61 | (260 129 4) 62 | (1006 134 110) 63 | (385 130 1) 64 | (24091 128 187 27) 65 | (736 132 96) 66 | (217215 140 159 127) 67 | (217106 140 159 18) 68 | (581215 162 187 95) 69 | (401277 151 189 125) 70 | (1244382 202 248 94) 71 | (1422664 213 233 72) 72 | (1856515 240 167 3) 73 | (399141 151 173 37) 74 | (1769209 234 252 121) 75 | (1900855 243 129 55) 76 | (523882 158 251 106) 77 | (2711024 128 164 186 112) 78 | (2763065 128 167 209 57) 79 | (2816187 128 170 240 59) 80 | (160111 136 225 111) 81 | (2199442 128 133 158 18) 82 | (2210863 128 133 247 47) 83 | (629324 165 179 76) 84 | (250884 142 167 4) 85 | (2532326 128 153 198 102)) 86 | "Test data for read-network-vli function") 87 | 88 | (defparameter +delta-vli-tests+ 89 | '((356 228 2) 90 | (3374 174 26) 91 | (1014 246 7) 92 | (1553 145 12) 93 | (31895 151 249 1) 94 | (6217 201 48) 95 | (321 193 2) 96 | (20157 189 157 1) 97 | (8113 177 63) 98 | (29519 207 230 1) 99 | (624 240 4) 100 | (755 243 5) 101 | (743 231 5) 102 | (360 232 2) 103 | (333 205 2) 104 | (498 242 3)) 105 | "Test data for read-delta-vli function") 106 | 107 | (defparameter +delta-result-value+ 108 | #(116 114 101 101 32 56 101 101 55 52 53 49 51 55 99 53 49 57 51 56 49 57 52 56 55 48 100 57 109 | 48 50 99 100 55 52 102 57 98 99 48 98 101 54 49 56 102 10 97 117 116 104 111 114 32 65 110 | 108 101 120 101 121 32 86 101 114 101 116 101 110 110 105 107 111 118 32 60 97 108 101 111 | 120 101 121 46 118 101 114 101 116 101 110 110 105 107 111 118 64 103 109 97 105 108 46 112 | 99 111 109 62 32 49 52 55 56 55 50 48 48 51 52 32 43 48 49 48 48 10 99 111 109 109 105 113 | 116 116 101 114 32 65 108 101 120 101 121 32 86 101 114 101 116 101 110 110 105 107 111 114 | 118 32 60 97 108 101 120 101 121 46 118 101 114 101 116 101 110 110 105 107 111 118 64 115 | 103 109 97 105 108 46 99 111 109 62 32 49 52 55 56 55 50 48 48 51 52 32 43 48 49 48 48 116 | 10 10 73 110 105 116 105 97 108 32 105 109 112 111 114 116 10) 117 | "Test data for apply-delta test function: the expected result (initial commit since delta 118 | applies from the current towards the oldest value") 119 | 120 | (defparameter +delta-delta-value+ 121 | #(135 2 217 1 45 116 114 101 101 32 56 101 101 55 52 53 49 51 55 99 53 49 57 51 56 49 57 52 56 122 | 55 48 100 57 48 50 99 100 55 52 102 57 98 99 48 98 101 54 49 56 102 145 93 67 3 48 51 52 123 | 145 163 76 26 48 51 52 32 43 48 49 48 48 10 10 73 110 105 116 105 97 108 32 105 109 112 124 | 111 114 116 10) 125 | "Test data for apply-delta test function: the delta itself") 126 | 127 | (defparameter +delta-base-value+ 128 | #(116 114 101 101 32 57 54 48 53 55 102 48 97 54 55 102 55 97 100 48 100 51 51 52 56 50 48 54 129 | 56 57 52 49 48 102 100 54 53 97 50 53 101 52 55 99 52 10 112 97 114 101 110 116 32 48 101 130 | 99 51 51 51 55 101 101 100 101 51 97 54 52 97 97 101 100 53 48 102 55 51 55 97 100 102 49 131 | 54 51 101 57 102 56 100 57 50 100 99 10 97 117 116 104 111 114 32 65 108 101 120 101 121 132 | 32 86 101 114 101 116 101 110 110 105 107 111 118 32 60 97 108 101 120 101 121 46 118 101 133 | 114 101 116 101 110 110 105 107 111 118 64 103 109 97 105 108 46 99 111 109 62 32 49 52 55 134 | 56 55 50 48 49 50 50 32 43 48 49 48 48 10 99 111 109 109 105 116 116 101 114 32 65 108 101 135 | 120 101 121 32 86 101 114 101 116 101 110 110 105 107 111 118 32 60 97 108 101 120 101 121 136 | 46 118 101 114 101 116 101 110 110 105 107 111 118 64 103 109 97 105 108 46 99 111 109 62 137 | 32 49 52 55 56 55 50 48 49 50 50 32 43 48 49 48 48 10 10 67 104 97 110 103 101 100 32 116 138 | 101 120 116 10) 139 | "Test data for apply-delta test function: the base value (most recent commit)") 140 | 141 | (defparameter +pack-entries-table-test-data-input+ 142 | (cons 3400 143 | #((12 . #(170 125 88 188 193 190 42 175 147 74 87 169 203 58 186 107 15 103 88 124)) 144 | (211 . #(210 21 120 108 198 104 190 23 48 254 232 11 226 181 22 86 210 131 245 22)) 145 | (451 . #(215 110 78 238 213 150 237 246 100 169 216 63 218 18 212 248 93 78 247 12)) 146 | (622 . #(235 180 136 136 92 169 146 109 105 199 247 232 24 222 110 204 250 25 51 58)) 147 | (828 . #(181 216 220 163 20 71 80 173 2 90 234 46 119 42 155 75 227 83 162 203)) 148 | (1019 . #(58 131 164 187 77 34 121 139 29 109 205 39 71 234 166 37 11 134 207 39)) 149 | (1206 . #(143 185 84 240 78 42 211 17 210 36 163 218 7 197 77 208 117 215 142 233)) 150 | (1395 . #(4 154 127 33 70 80 131 143 14 225 65 220 78 105 169 138 72 227 131 110)) 151 | (1581 . #(140 72 116 24 232 136 241 161 51 61 12 46 227 158 222 147 88 38 28 95)) 152 | (1764 . #(47 230 155 236 217 187 24 60 42 137 182 128 61 142 80 105 207 102 72 113)) 153 | (1980 . #(105 117 108 40 248 131 29 71 127 160 168 252 69 236 212 6 162 123 115 132)) 154 | (2187 . #(70 189 125 78 236 66 90 134 154 201 214 215 216 146 167 54 62 89 29 209)) 155 | (2375 . #(35 69 68 243 218 171 233 181 171 210 112 41 160 86 154 155 128 150 112 81)) 156 | (2554 . #(229 251 67 170 147 134 28 164 56 217 250 109 48 209 234 68 81 137 191 110)) 157 | (2745 . #(233 236 85 96 214 78 104 22 108 170 89 173 203 28 99 207 43 195 18 187)) 158 | (2942 . #(51 160 204 102 7 187 241 68 175 198 69 193 17 225 67 125 172 155 34 248)) 159 | (3323 . #(208 111 197 43 241 252 140 124 39 197 75 198 249 136 34 252 120 250 43 59)))) 160 | "Test data for the create-pack-entries-table-initial function test") 161 | 162 | (defparameter +pack-entries-table-test-data-output+ 163 | '((12 . 199) 164 | (211 . 240) 165 | (451 . 171) 166 | (622 . 206) 167 | (828 . 191) 168 | (1019 . 187) 169 | (1206 . 189) 170 | (1395 . 186) 171 | (1581 . 183) 172 | (1764 . 216) 173 | (1980 . 207) 174 | (2187 . 188) 175 | (2375 . 179) 176 | (2554 . 191) 177 | (2745 . 197) 178 | (2942 . 381) 179 | (3323 . 57)) 180 | "Contents (values) of the hash table generated by create-pack-entries-table-initial function") 181 | 182 | (defparameter +pack-file-git-output+ 183 | "cb96e53d08dbfc0d358c5f312029aecaf584a390 commit 269 165 12 184 | a2194f882da560df01357af06a4a7cc91614ee94 commit 263 164 177 185 | 0ec3337eede3a64aaed50f737adf163e9f8d92dc commit 87 98 341 1 a2194f882da560df01357af06a4a7cc91614ee94 186 | 19d6a183e50f8a5cded152d9c755bc23e5a89517 blob 6322 2292 439 187 | 9eeff76aaa278e9253b0106dfab6b8ab2619d695 blob 296 248 2731 1 19d6a183e50f8a5cded152d9c755bc23e5a89517 188 | dee95d63ff98bc1b1ef6e26ae7d83eb40d653d3e blob 2000 907 2979 189 | aca7baf1ea0bc6cc23f92edf55ac2e4ea6586f21 tree 83 83 3886 190 | 96057f0a67f7ad0d334820689410fd65a25e47c4 tree 41 52 3969 191 | 8ee745137c51938194870d902cd74f9bc0be618f tree 41 52 4021" 192 | "The output of the 'git verify-pack -v pack-559f5160ab63a074f365f538d209164b5d8a715a.pack' 193 | command in the t/data/example-repo/objects/pack directory") 194 | 195 | (plan nil) 196 | 197 | 198 | 199 | (subtest "Test conditions" 200 | (let ((general-condition 201 | (make-condition 'git-api.pack::pack-error :text "general pack error"))) 202 | (ok (starts-with-subseq "Pack file error:" (format nil "~A" general-condition))))) 203 | 204 | (defmacro stream-readers-test (description function test-data) 205 | `(subtest ,description 206 | (loop for test-case in ,test-data 207 | for value = (car test-case) 208 | and stream = (flexi-streams:make-in-memory-input-stream (cdr test-case)) 209 | do 210 | (is value (,function stream) (format nil "reading value ~a" value))))) 211 | 212 | 213 | (stream-readers-test "Testing read-network-vli" read-network-vli +network-vli-tests+) 214 | (stream-readers-test "Testing read-delta-vli" read-delta-vli +delta-vli-tests+) 215 | 216 | 217 | (subtest "Testing pack-filename-to-index" 218 | (let ((pack1 "//some/weird-filename1.pack") 219 | (pack2 "//some/weird filename2.PACK") 220 | (pack3 "weird filename3.PackK") 221 | (pack4 "completely weird filename")) 222 | (is (pack-filename-to-index pack1) "//some/weird-filename1.idx" :test #'string= 223 | "normal case") 224 | (is (pack-filename-to-index pack2) "//some/weird filename2.idx" :test #'string= 225 | "upper-case extension") 226 | (is-error (pack-filename-to-index pack3) 'incorrect-file-name-error 227 | "too long extension") 228 | (is-error (pack-filename-to-index pack4) 'incorrect-file-name-error 229 | "completely weird filename"))) 230 | 231 | (subtest "Testing index-filename-to-pack" 232 | (let ((idx1 "//some/weird-filename1.idx") 233 | (idx2 "//some/weird filename2.IDX") 234 | (idx3 "weird filename3.iDXX") 235 | (idx4 "completely weird filename")) 236 | (is (index-filename-to-pack idx1) "//some/weird-filename1.pack" :test #'string= 237 | "normal case") 238 | (is (index-filename-to-pack idx2) "//some/weird filename2.pack" :test #'string= 239 | "upper-case extension") 240 | (is-error (index-filename-to-pack idx3) 'incorrect-file-name-error 241 | "too long extension") 242 | (is-error (index-filename-to-pack idx4) 'incorrect-file-name-error 243 | "completely weird filename") 244 | (is idx1 (pack-filename-to-index (index-filename-to-pack idx1)) :test #'string= 245 | "conversion from index to pack and back"))) 246 | 247 | (subtest "Testing parse-index-file" 248 | ;; catch the error condition 249 | (is-error (parse-index-file (testfile "binary.dat")) 'corrupted-index-file-error 250 | "Test raised condition on corrupted file") 251 | ;; parse file 252 | (multiple-value-bind (offsets index) 253 | (parse-index-file (testfile "test.idx")) 254 | ;; verify what return values are not empty 255 | (isnt offsets nil "check returned offsets not nil") 256 | (isnt index nil "check returned index not nil") 257 | ;; read the index from pre-parsed data 258 | (let ((saved-index 259 | (with-open-file (s (testfile "test_idx.sexp") :direction :input) 260 | (read s)))) 261 | (is index saved-index "check index read is the same as expected" 262 | :test #'equalp)) 263 | (let ((expected-offsets (make-hash-table :test #'eq :size (length index)))) 264 | (loop for (x . y) across index 265 | do (setf (gethash x expected-offsets) y)) 266 | (is offsets expected-offsets "check offsets are the same as in index array" 267 | :test #'equalp)))) 268 | 269 | (subtest "Testing read-fanout-table" 270 | ;; prepare the test data 271 | (let* ((fanout-table ; the array with encoded 256 numbers 272 | (make-array 256 :initial-contents 273 | (loop for i from 0 below 256 collect (random (ash 2 30))))) 274 | (encoded-array 275 | (flexi-streams:with-output-to-sequence (stream) ; encode to in-memory stream 276 | (loop for x across fanout-table 277 | do (write-ub32/be x stream))))) 278 | ;; now reopen the test data as a stream 279 | (flexi-streams:with-input-from-sequence (stream encoded-array) 280 | (is (read-fanout-table stream) fanout-table "check random 256 values in fanout table" 281 | :test #'equalp)))) 282 | 283 | 284 | 285 | (defun create-small-random-offsets (size) 286 | (let ((offset 287 | (min 31 (integer-length most-positive-fixnum)))) 288 | (make-array size :initial-contents 289 | (loop for i from 0 below size collect (random (ash 1 offset)))))) 290 | 291 | (defun create-big-random-offsets (size) 292 | (make-array size :initial-contents 293 | (loop for i from 0 below size collect (random (ash 2 63))))) 294 | 295 | 296 | (subtest "Testing read-offsets" 297 | ;; read-offsets 298 | (let* ((size-smalls 10) 299 | (size-bigs 1) 300 | (table-small (create-small-random-offsets size-smalls)) 301 | (table-big (create-big-random-offsets size-bigs))) 302 | (declare (ignore table-big)) 303 | (flet ((test-small-table (small-table description) 304 | ;; encode smalls into the stream 305 | (let ((table 306 | (flexi-streams:with-output-to-sequence (stream) 307 | (loop for x across small-table do (write-ub32/be x stream))))) 308 | (flexi-streams:with-input-from-sequence (stream table) 309 | (is (read-offsets stream (length small-table)) small-table 310 | description 311 | 312 | :test #'equalp))))) 313 | (test-small-table table-small "check simple table with random values < 2^31")) 314 | ;; test of small offsets + big offsets 315 | ;; (let ((order (random-shuffle (iota (+ size-smalls size-bigs))) 316 | (skip 1 "TODO: reimplement large offsets handling and enable this test") 317 | #| 318 | (let ((table 319 | (flexi-streams:with-output-to-sequence (stream) 320 | (loop for x across table-small do (write-ub32/be x stream)) 321 | (loop for i below size-bigs do (write (logior (ash 1 31) i))) 322 | (loop for x across table-big do (write-ub64/be x stream))))) 323 | (flexi-streams:with-input-from-sequence (stream table) 324 | (is (read-offsets stream (+ size-smalls size-bigs)) table-small :test #'equalp))))) 325 | |# 326 | )) 327 | 328 | 329 | (subtest "Testing decode-delta-copy-cmd" 330 | (let* ((size-bytes (make-array 4 :element-type '(unsigned-byte 8) :initial-contents '(#x00 #xaa #x00 #x00))) 331 | (offset-bytes (make-array 4 :element-type '(unsigned-byte 8) :initial-contents '( #x00 #x00 #xcc #xdd))) 332 | (size-encoded-bits #b010) 333 | (offset-encoded-bits #b1100) 334 | ;; the data itself 335 | (data (vector (logior #x80 (ash size-encoded-bits 4) offset-encoded-bits) 336 | #xcc #xdd ; first parts of offset 337 | #xaa))) ; and then parts of size 338 | (multiple-value-bind (new-pos offset size) 339 | (decode-delta-copy-cmd data 0) 340 | (is new-pos 3 "Check if new position is 3") 341 | (is offset (nibbles:ub32ref/le offset-bytes 0) "check if decoded offset is correct") 342 | (is size (nibbles:ub32ref/le size-bytes 0) "check if decoded size is correct")))) 343 | 344 | 345 | (subtest "Testing apply-delta" 346 | (is-error (apply-delta #(1 2 3 4 5) +delta-delta-value+) 347 | 'corrupted-pack-file-error 348 | "Test what apply-delta raise an error when the base of incorrect size provided") 349 | (is-error (apply-delta +delta-base-value+ (concatenate 'vector (subseq +delta-delta-value+ 0 4) #(0 0 0 0 0 0))) 350 | 'corrupted-pack-file-error 351 | "Test what apply-delta raise an error when incorrect delta-command(0) encountered") 352 | (is 353 | (apply-delta +delta-base-value+ +delta-delta-value+) 354 | +delta-result-value+ 355 | "Test of commit deltas" 356 | :test #'equalp)) 357 | 358 | 359 | (subtest "Test of create-pack-entries-table-initial" 360 | (let ((table (create-pack-entries-table-initial 361 | (cdr +pack-entries-table-test-data-input+) ;; table 362 | (car +pack-entries-table-test-data-input+)))) ;; size 363 | (is (hash-table-count table) (length (cdr +pack-entries-table-test-data-input+)) 364 | "Check what the hash table contains all the entries") 365 | (loop for x across (cdr +pack-entries-table-test-data-input+) 366 | for y in +pack-entries-table-test-data-output+ 367 | for sha1 = (cdr x) 368 | do 369 | (is (gethash sha1 table) y (format nil "check ~a has (offset size) of ~a" (sha1-to-hex sha1) y))))) 370 | 371 | 372 | (subtest "Test of read-pack-entry-header" 373 | (let ((test1 '(149 236 3)) ;; size + data 374 | (test2 '(230 13 134 110)) ;; (230 13) 2 bytes of type delta-offset 375 | ;;; Construct the test data to test delta reference: 376 | ;;; size = 1000 377 | ;;; type = 7 378 | ;;; 1000 = b0000 0011 1110 1000 379 | ;;; construct the header: 380 | ;;; msb = 1 381 | ;;; next 3 bits = 7 = b111 382 | ;;; least significant 4 bits of 1000 = b1000 383 | ;;; finally: 384 | ;;; 1111 1000 0011 1110 385 | ;;; = (248 62) 386 | (test3 '(248 62 ;; type 7 size 1000 387 | 215 110 78 238 213 150 237 246 100 169 216 63 218 18 212 248 93 78 247 12))) ;; 20 bytes sha1 388 | ;(diag (format nil "Test decoding of the bytes ~a, type 1 and size 7877" test1)) 389 | (flexi-streams:with-input-from-sequence (stream test1) 390 | (multiple-value-bind (type len base-hash base-offset) 391 | (read-pack-entry-header stream) 392 | (declare (ignore base-hash base-offset)) 393 | (is type 1 "Check if type is 1") 394 | (is len 7877 "Check if length is 7877"))) 395 | ;; 1006 - offset 396 | ;(diag (format nil "Test decoding of the bytes ~a, type 6 and offset 1006" test2)) 397 | (flexi-streams:with-input-from-sequence (stream test2) 398 | (multiple-value-bind (type len base-hash base-offset) 399 | (read-pack-entry-header stream) 400 | (declare (ignore base-hash)) 401 | (is type 6 "Check if type is 6") 402 | (is len 214 "Check if length is 214") 403 | (is base-offset 1006 "Check if offset is 1006"))) 404 | (flexi-streams:with-input-from-sequence (stream test3) 405 | (multiple-value-bind (type len base-hash base-offset) 406 | (read-pack-entry-header stream) 407 | (declare (ignore base-offset)) 408 | (is type 7 "Check if type is 7") 409 | (is len 1000 "Check if length is 1000") 410 | (is base-hash (coerce (subseq test3 2) 'vector) 411 | (format nil "Check if hash is ~a" (sha1-to-hex (subseq test3 2))) :test #'equalp))))) 412 | 413 | 414 | (subtest "pack-entry class test" 415 | (let ((entry 416 | (make-instance 'pack-entry 417 | :type :commit 418 | :offset 100 419 | :compressed-size 200)) 420 | (entry-delta 421 | (make-instance 'pack-entry-delta 422 | :offset 100 423 | :base-hash (make-array 20 424 | :element-type '(unsigned-byte 8) 425 | :initial-contents 426 | '(215 110 78 238 213 150 237 246 100 169 216 63 218 18 212 248 93 78 247 12))))) 427 | (is-print (princ entry) "commit 0 200 100" "Test print of pack-entry") 428 | (is-print (princ entry-delta) "NIL 0 0 100 d76e4eeed596edf664a9d83fda12d4f85d4ef70c" "Test print of pack-entry-delta") 429 | (setf (pack-entry-type entry) +obj-blob+) 430 | (is-print (princ entry) "blob 0 200 100" "Test (setf (pack-entry-type entry) with +obj-blob+") 431 | (setf (pack-entry-type entry) +obj-commit+) 432 | (is-print (princ entry) "commit 0 200 100" "Test (setf (pack-entry-type entry) with +obj-commit+") 433 | (setf (pack-entry-type entry) +obj-tag+) 434 | (is-print (princ entry) "tag 0 200 100" "Test (setf (pack-entry-type entry) with +obj-tag+") 435 | (setf (pack-entry-type entry) +obj-tree+) 436 | (is-print (princ entry) "tree 0 200 100" "Test (setf (pack-entry-type entry) with +obj-tree+"))) 437 | 438 | 439 | (defun parse-git-verify-pack-output (output) 440 | "Returns the list of pack-entries created from the output of the 'git verify-pack -v' command" 441 | ;; format of the git verify-pack -v output: 442 | ;; for non-deltified objects: 443 | ;; SHA-1 type size size-in-packfile offset-in-packfile 444 | ;; for deltified objects: 445 | ;; SHA-1 type size size-in-packfile offset-in-packfile depth base-SHA-1 446 | ;; test: (inspect (parse-git-verify-pack-output +pack-file-git-output+)) 447 | (let* ((objects (mapcar (lambda (x) (split-sequence:split-sequence #\space x :remove-empty-subseqs t)) 448 | (split-sequence:split-sequence #\newline output))) 449 | (result (make-hash-table :test #'equalp :size (length objects)))) 450 | (mapc (lambda (obj) 451 | (setf (gethash (car obj) result) 452 | (let ((entry 453 | (make-instance 'pack-entry :type 454 | (intern (string-upcase (elt obj 1)) "KEYWORD") 455 | :uncompressed-size (parse-integer (elt obj 2)) 456 | :compressed-size (parse-integer (elt obj 3)) 457 | :offset (parse-integer (elt obj 4))))) 458 | (when (> (length obj) 5) ; delta 459 | (change-class entry 'pack-entry-delta) 460 | (setf (pack-entry-base-hash entry) (elt obj 6))) 461 | entry))) 462 | objects) 463 | result)) 464 | 465 | 466 | (subtest "Test of the create-indexes-from-pack-file" 467 | (is-error (create-indexes-from-pack-file (namestring (testfile "corrupted_pack0.pack"))) 'corrupted-pack-file-error 468 | "Test for correct PACK file header") 469 | (is-error (create-indexes-from-pack-file (namestring (testfile "corrupted_pack1.pack"))) 'corrupted-pack-file-error 470 | "Test for correct version in PACK file header") 471 | (is-error (create-indexes-from-pack-file (namestring (testfile "corrupted_pack2.pack"))) 'corrupted-pack-file-error 472 | "Test for matching number of objects in index and pack file") 473 | (let ((tables 474 | (create-indexes-from-pack-file 475 | (namestring (testfile "example-repo/objects/pack/pack-559f5160ab63a074f365f538d209164b5d8a715a.pack")))) 476 | (test-data (parse-git-verify-pack-output +pack-file-git-output+))) 477 | (is (hash-table-count (car tables)) (hash-table-count test-data) "Check if size of the first parsed table is correct") 478 | (is (hash-table-count (cdr tables)) (hash-table-count test-data) "Check if sizes of the second parsed table is correct") 479 | ;; offsets table 480 | (maphash (lambda (k v) 481 | (is k (pack-entry-offset (gethash (sha1-to-hex v) test-data)) 482 | (format nil "offsets table: check offset for entry ~a" (sha1-to-hex v)))) 483 | (car tables)) 484 | ;; initial index table 485 | (maphash (lambda (k v) 486 | (is (car v) (pack-entry-offset (gethash (sha1-to-hex k) test-data)) 487 | (format nil "index table: Check offset for entry ~a" (sha1-to-hex k))) 488 | (is (cdr v) (pack-entry-compressed-size (gethash (sha1-to-hex k) test-data)) 489 | (format nil "index table: Check compressed size for entry ~a" (sha1-to-hex k)))) 490 | (cdr tables)))) 491 | 492 | 493 | (defun test-parse-pack-file (blob-obj delta-obj pack subtest-name) 494 | (subtest subtest-name 495 | (is-type pack 'pack-file "Test if parse-pack-file returned instance of type pack-file") 496 | ;; check what pack-open-stream works and do not fail on double calls 497 | (pack-close-stream pack) 498 | (pack-open-stream pack) 499 | (pack-open-stream pack) 500 | (multiple-value-bind (blob size type) 501 | (pack-get-object-by-hash pack "dee95d63ff98bc1b1ef6e26ae7d83eb40d653d3e") 502 | (is type :blob "Test the type of object is correct") 503 | (is blob-obj 504 | (babel:octets-to-string blob :end size) 505 | "Test of pack-get-object-by-hash for blob object")) 506 | ;; finally close the stream, continue testing without it 507 | (pack-close-stream pack) 508 | (is delta-obj 509 | (babel:octets-to-string (pack-get-object-by-hash pack "9eeff76aaa278e9253b0106dfab6b8ab2619d695")) 510 | "Test of pack-get-object-by-hash for delta object"))) 511 | 512 | 513 | (defun read-string (filename) 514 | (alexandria:read-file-into-string filename 515 | :external-format 516 | #+(and :ccl :windows) 517 | (ccl::make-external-format :line-termination :CRLF) 518 | #-(and :ccl :windows) 519 | :default)) 520 | 521 | (let ((blob-obj 522 | (read-string (testfile "example-repo-extracted/dee95d63ff98bc1b1ef6e26ae7d83eb40d653d3e.contents"))) 523 | (delta-obj 524 | (read-string (testfile "example-repo-extracted/9eeff76aaa278e9253b0106dfab6b8ab2619d695.contents"))) 525 | (pack 526 | (parse-pack-file 527 | (namestring (testfile "example-repo/objects/pack/pack-559f5160ab63a074f365f538d209164b5d8a715a.pack"))))) 528 | (test-parse-pack-file blob-obj delta-obj pack "Test of the parse-pack-file with default CFFI zlib(or default)") 529 | (let ((git-api.zlib.cffi:*zlib-loaded* nil)) 530 | (test-parse-pack-file blob-obj delta-obj pack "Test of the parse-pack-file with CL zlib"))) 531 | 532 | 533 | (finalize) 534 | -------------------------------------------------------------------------------- /t/repo-test.lisp: -------------------------------------------------------------------------------- 1 | ;;;; repo-test.lisp 2 | ;; NOTE: To run this test file, execute `(asdf:test-system :git-api)' in your Lisp. 3 | ;; 4 | 5 | (in-package :cl-user) 6 | (defpackage git-api.test.repo-test 7 | (:use :cl 8 | :alexandria 9 | :git-api.test.base 10 | :git-api.utils 11 | :git-api.repo 12 | :prove)) 13 | 14 | (in-package git-api.test.repo-test) 15 | 16 | ;; import unexterned(private for package) functions 17 | (from nibbles import write-ub64/be write-ub32/be) 18 | (from git-api.utils import sha1-to-hex) 19 | 20 | 21 | (plan nil) 22 | 23 | (subtest "Smoke test of the example repository" 24 | (let* ((repo (make-git-repo (namestring (testfile "example-repo"))))) 25 | (is-type repo 'git-api.repo::git-repo "Check if we able to create repository object") 26 | (let ((commits-tree (get-commit-tree repo (get-head-commit repo)))) 27 | (is-type commits-tree 'hash-table "Check if we able to create a hash table of commits") 28 | (is (hash-table-count commits-tree) 3 "Check the number of commits") 29 | (is-type (gethash "cb96e53d08dbfc0d358c5f312029aecaf584a390" commits-tree) 'git-api.object:commit 30 | "Check commit 1") 31 | (is-type (gethash "a2194f882da560df01357af06a4a7cc91614ee94" commits-tree) 'git-api.object:commit 32 | "Check commit 2") 33 | (is-type (gethash "0ec3337eede3a64aaed50f737adf163e9f8d92dc" commits-tree) 'git-api.object:commit 34 | "Check commit 3")))) 35 | 36 | (finalize) 37 | -------------------------------------------------------------------------------- /t/utils-test.lisp: -------------------------------------------------------------------------------- 1 | ;;;; utils-test.lisp 2 | ;; NOTE: To run this test file, execute `(asdf:test-system :git-api)' in your Lisp. 3 | ;; 4 | 5 | (in-package :cl-user) 6 | (defpackage git-api.test.utils-test 7 | (:use :cl 8 | :git-api.test.base 9 | :git-api.utils 10 | :prove)) 11 | (in-package :git-api.test.utils-test) 12 | 13 | (from git-api.utils import digit-to-hex) 14 | 15 | (defparameter *binary-file-contents* #(11 254 217 187 174 147 78 237 39 142 185 14 115 180 215 10 231 38 250 27 196 134 119 20 161 85 86 185 24 28 103 110 142 20 59 126 103 36 48 203 95 24 76 22 26 247 254 150 174 87 83 131 0 164 115 135 231 240 39 250 114 24 242 237 209 84 131 200 201 3 126 212) 16 | "Contents of the binary.dat") 17 | 18 | (defparameter *sha-sequence-1* '(00 00 65 32 116 101 115 116 32 111 102 32 111 110 101 32 108 105 110 101 32 114)) 19 | (defparameter *sha-sequence-1-hex* "412074657374206f66206f6e65206c696e652072") 20 | 21 | (defparameter *sha-sequence-2* '(00 00 #xf0 #x0d #x0e #xec #x43 #xec #x0e #x28 #xd1 #x33 #xba #xe8 #xa2 #x97 #xf8 #x1e #x23 #x78 #x22 #x09)) 22 | (defparameter *sha-sequence-2-hex* "f00d0eec43ec0e28d133bae8a297f81e23782209") 23 | 24 | 25 | (plan nil) 26 | 27 | (is (read-one-line (testfile "readoneline.txt")) 28 | "A test of one line reading from the file." 29 | "Test of read-one-line") 30 | 31 | (is (file-size (testfile "binary.dat")) (length *binary-file-contents*) 32 | "Test of file-size") 33 | 34 | (is (read-binary-file (testfile "binary.dat")) 35 | *binary-file-contents* 36 | :test #'equalp 37 | "Test of read-binary-file") 38 | 39 | (subtest "Testing read-header" 40 | (is (read-header (testfile "binary.dat") 5) 41 | (subseq *binary-file-contents* 0 5) 42 | :test #'equalp 43 | "Test of read-header: read first 5 bytes") 44 | (is (read-header (testfile "binary.dat") (+ 10 (length *binary-file-contents*))) 45 | *binary-file-contents* 46 | :test #'equalp 47 | "Test of read-header: read first more than size of file")) 48 | 49 | 50 | (subtest "Testing sha1-to-hex" 51 | (is (flexi-streams:with-input-from-sequence (seq (subseq *sha-sequence-1* 2)) 52 | (sha1-to-hex seq)) 53 | *sha-sequence-1-hex* 54 | "Stream to hex test 1") 55 | (is (flexi-streams:with-input-from-sequence (seq (subseq *sha-sequence-2* 2)) 56 | (sha1-to-hex seq)) 57 | *sha-sequence-2-hex* 58 | "Stream to hex test 2") 59 | (is (sha1-to-hex *sha-sequence-1* 2) 60 | *sha-sequence-1-hex* 61 | "List to hex test 1") 62 | (is (sha1-to-hex *sha-sequence-2* 2) 63 | *sha-sequence-2-hex* 64 | "List to hex test 2") 65 | (is (sha1-to-hex 66 | (make-array 22 :element-type '(unsigned-byte 8) :initial-contents *sha-sequence-1*) 2) 67 | *sha-sequence-1-hex* 68 | "Array to hex test 1") 69 | (is (sha1-to-hex 70 | (make-array 22 :element-type '(unsigned-byte 8) :initial-contents *sha-sequence-2*) 2) 71 | *sha-sequence-2-hex* 72 | "Array to hex test 2") 73 | (is (sha1-to-hex 74 | #(51 160 204 102 7 187 241 68 175 198 69 193 17 225 67 125 172 155 34 248)) 75 | "33a0cc6607bbf144afc645c111e1437dac9b22f8" 76 | "Array to hex test 3 - the ordinary unoptimized version") 77 | (is (sha1-hex-to-array *sha-sequence-1-hex*) 78 | (make-array 20 :element-type '(unsigned-byte 8) :initial-contents (subseq *sha-sequence-1* 2)) 79 | :test #'equalp 80 | "Hex string to array test 1") 81 | (let* ((result (make-array 20 :element-type '(unsigned-byte 8))) 82 | (expected-result (make-array 20 :element-type '(unsigned-byte 8) :initial-contents (subseq *sha-sequence-2* 2))) 83 | (actual-result (sha1-hex-to-array *sha-sequence-2-hex* result))) 84 | (is-type actual-result '(simple-array (unsigned-byte 8) (20)) 85 | "Hex string to array test 2 - result should be an array of size 20") 86 | (is actual-result 87 | expected-result 88 | :test #'equalp 89 | "Hex string to array test 3 - result array given, check return value") 90 | (is result 91 | expected-result 92 | :test #'equalp 93 | "Hex string to array test 4 - check if result array is hte same as expected result"))) 94 | 95 | 96 | (subtest "Test digit-to-hex macro" 97 | (is (digit-to-hex 1) #\1 "Test (digit-to-hex 1) is '1'") 98 | (is (digit-to-hex 9) #\9 "Test (digit-to-hex 9) is '9'") 99 | (is (digit-to-hex 11) #\b "Test (digit-to-hex 11) is 'b'") 100 | (is (digit-to-hex 15) #\f "Test (digit-to-hex 15) is 'f'")) 101 | 102 | 103 | (finalize) 104 | -------------------------------------------------------------------------------- /t/wrapper-test.lisp: -------------------------------------------------------------------------------- 1 | ;;;; wrapper-test.lisp 2 | ;; NOTE: To run this test file, execute `(asdf:test-system :git-api)' in your Lisp. 3 | ;; 4 | 5 | (in-package :cl-user) 6 | (defpackage git-api.test.wrapper-test 7 | (:use :cl 8 | :alexandria 9 | :git-api.utils 10 | :git-api.test.base 11 | :git-api.zlib.wrapper 12 | :prove)) 13 | 14 | (in-package git-api.test.wrapper-test) 15 | 16 | ;; import unexterned(private for package) functions 17 | (from git-api.zlib.wrapper import uncompress-git-file uncompress-git-file-cffi) 18 | 19 | (defparameter +big-data-uncompressed+ 20 | #(98 108 111 98 32 55 57 0 109 121 32 118 101 114 121 32 108 101 110 103 116 104 121 32 115 116 114 105 110 103 46 32 65 112 112 97 114 101 110 116 108 121 32 116 111 32 101 120 99 101 101 100 32 116 104 101 32 51 50 32 98 121 116 101 115 32 115 105 122 101 32 111 102 32 116 111 116 97 108 32 97 114 99 104 105 118 101)) 21 | 22 | (defparameter +small-data-uncompressed+ 23 | #(98 108 111 98 32 49 54 0 119 104 97 116 32 105 115 32 117 112 44 32 100 111 99 63)) 24 | 25 | (plan nil) 26 | 27 | (subtest "Test of the uncompress-git-file-zlib" 28 | (let ((git-api.zlib.cffi:*zlib-loaded* nil)) 29 | (is (uncompress-git-file (testfile "example-objects/small-git-object.dat")) 30 | +small-data-uncompressed+ "Test uncompress-git-file with CL zlib on small file" :test #'equalp) 31 | (is (uncompress-git-file (testfile "example-objects/big-git-object.dat")) 32 | +big-data-uncompressed+ "Test uncompress-git-file with CL zlib on big file" :test #'equalp))) 33 | 34 | (subtest "Test of the uncompress-git-file-cffi" 35 | (when git-api.zlib.cffi:*zlib-loaded* t 36 | (is (uncompress-git-file (testfile "example-objects/small-git-object.dat")) 37 | +small-data-uncompressed+ "Test uncompress-git-file with cffi-zlib on small file" :test #'equalp) 38 | (is (uncompress-git-file (testfile "example-objects/big-git-object.dat")) 39 | +big-data-uncompressed+ "Test uncompress-git-file with cffi-zlib on big file" :test #'equalp))) 40 | 41 | 42 | (subtest "Test of the example git commit" 43 | (let* ((input-file (testfile "git-commit.compressed")) 44 | (uncompressed-file (testfile "git-commit.uncompressed")) 45 | (expected (read-binary-file uncompressed-file))) 46 | (let ((git-api.zlib.cffi:*zlib-loaded* nil)) 47 | (is (uncompress-git-file input-file) expected "Testing of uncompress-git-file without zlib loaded" :test #'equalp)) 48 | (let ((git-api.zlib.cffi:*zlib-loaded* t)) 49 | (is (uncompress-git-file input-file) expected "Testing of uncompress-git-file with zlib loaded" :test #'equalp)))) 50 | 51 | (finalize) 52 | --------------------------------------------------------------------------------