--- /dev/null
+! Copyright (C) 2015 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs assocs.extras calendar
+calendar.format checksums checksums.sha combinators
+combinators.smart compression.zlib constructors fry grouping io
+io.binary io.directories io.directories.search
+io.encodings.binary io.encodings.string io.encodings.utf8
+io.files io.files.info io.pathnames io.streams.byte-array
+io.streams.peek kernel math math.bitwise math.parser
+math.statistics memoize namespaces random sequences
+sequences.extras splitting strings ;
+IN: git
+
+ERROR: byte-expected offset ;
+: read1* ( -- n )
+ read1 [ tell-input byte-expected ] unless* ;
+
+ERROR: separator-expected expected-one-of got ;
+
+: read-until* ( separators -- data )
+ dup read-until [ nip ] [ separator-expected ] if ;
+
+: find-git-directory ( path -- path' )
+ [ ".git" tail? ] find-up-to-root ; inline
+
+ERROR: not-a-git-directory path ;
+
+: current-git-directory ( -- path )
+ current-directory get find-git-directory [
+ current-directory get not-a-git-directory
+ ] unless* ;
+
+: make-git-path ( str -- path )
+ current-git-directory prepend-path ;
+
+: make-refs-path ( str -- path )
+ [ "refs/" make-git-path ] dip append-path ;
+
+: make-object-path ( str -- path )
+ [ "objects/" make-git-path ] dip 2 cut append-path append-path ;
+
+: make-idx-path ( sha -- path )
+ "objects/pack/pack-" ".idx" surround make-git-path ;
+
+: make-pack-path ( sha -- path )
+ "objects/pack/pack-" ".pack" surround make-git-path ;
+
+: git-binary-contents ( str -- contents )
+ make-git-path binary file-contents ;
+
+: git-utf8-contents ( str -- contents )
+ make-git-path utf8 file-contents ;
+
+: git-lines ( str -- contents )
+ make-git-path utf8 file-lines ;
+
+ERROR: expected-one-line lines ;
+
+: git-line ( str -- contents )
+ git-lines dup length 1 =
+ [ first ] [ expected-one-line ] if ;
+
+: git-unpacked-object-exists? ( hash -- ? )
+ make-object-path exists? ;
+
+TUPLE: index-entry ctime mtime dev ino mode uid gid size sha1 flags name ;
+CONSTRUCTOR: <index-entry> index-entry ( ctime mtime dev ino mode uid gid size sha1 flags name -- obj ) ;
+
+: read-index-entry-v2 ( -- seq )
+ 4 read be> 4 read be> 2array
+ 4 read be> 4 read be> 2array
+ 4 read be>
+ 4 read be>
+ 4 read be>
+ 4 read be>
+ 4 read be>
+ 4 read be>
+ 20 read bytes>hex-string
+ 2 read be> { 0 } read-until drop [ utf8 decode ] [ length ] bi
+ 7 + 8 mod dup zero? [ 8 swap - ] unless read drop
+ <index-entry> ;
+
+TUPLE: git-index magic version entries checksum ;
+CONSTRUCTOR: <git-index> git-index ( magic version entries checksum -- obj ) ;
+
+ERROR: unhandled-git-version n ;
+ERROR: unhandled-git-index-trailing-bytes bytes ;
+
+: git-index-contents ( -- git-index )
+ "index" make-git-path binary [
+ 4 read utf8 decode
+ 4 read be>
+ 4 read be> over {
+ { 2 [ [ read-index-entry-v2 ] replicate ] }
+ [ unhandled-git-version ]
+ } case
+ 20 read bytes>hex-string
+ <git-index>
+ ] with-file-reader ;
+
+: make-git-object ( str -- obj )
+ [
+ [ "blob " ] dip [ length number>string "\0" ] [ ] bi
+ ] B{ } append-outputs-as ;
+
+: path>git-object ( path -- bytes )
+ binary file-contents make-git-object sha1 checksum-bytes ;
+
+: git-hash-object ( str -- hash )
+ make-git-object sha1 checksum-bytes ;
+
+: changed-index-by-sha1 ( -- seq )
+ git-index-contents entries>>
+ [ [ sha1>> ] [ name>> path>git-object bytes>hex-string ] bi = not ] filter ;
+
+: changed-index-by-mtime ( -- seq )
+ git-index-contents entries>>
+ [
+ [ mtime>> first ]
+ [ name>> file-info modified>> timestamp>unix-time >integer ] bi = not
+ ] filter ;
+
+TUPLE: commit hash tree parents author committer message ;
+CONSTRUCTOR: <commit> commit ( tree parents author committer -- obj ) ;
+
+TUPLE: tree hash tree parents author committer message ;
+CONSTRUCTOR: <tree> tree ( -- obj ) ;
+
+: last2 ( seq -- penultimate ultimate ) 2 tail* first2 ;
+
+: gmt-offset>duration ( string -- duration )
+ 3 cut [ string>number ] bi@
+ [ hours ] [ minutes ] bi* time+ ;
+
+: date>string ( seq -- string )
+ last2
+ [ string>number unix-time>timestamp ]
+ [ gmt-offset>duration [ time+ ] [ >>gmt-offset ] bi ] bi*
+ timestamp>git-time ;
+
+: commit. ( commit -- )
+ {
+ [ hash>> "commit " prepend print ]
+ [ author>> "Author: " prepend " " split 2 head* " " join print ]
+ [ author>> " " split date>string "Date: " prepend print ]
+ [ message>> "\n" split [ " " prepend ] map "\n" join nl print nl ]
+ } cleave ;
+
+ERROR: unknown-commit-line line name ;
+
+ERROR: string-expected got expected ;
+
+: expect-string ( string expected -- )
+ 2dup = [ 2drop ] [ string-expected ] if ;
+
+ERROR: eof-too-early ;
+ERROR: unknown-field field ;
+
+: parse-commit-field ( obj parameter -- obj )
+ [ "\r\n" read-until [ eof-too-early ] unless ] dip {
+ { "tree" [ >>tree ] }
+ { "parent" [ >>parents ] }
+ { "author" [ >>author ] }
+ { "committer" [ >>committer ] }
+ [ unknown-field ]
+ } case ;
+
+ERROR: unexpected-text text ;
+
+: parse-commit-lines ( obj -- obj )
+ " \n" read-until {
+ { CHAR: \s [ parse-commit-field parse-commit-lines ] }
+ { CHAR: \n [ drop contents >>message ] }
+ [ unexpected-text ]
+ } case ;
+
+: parse-commit ( bytes -- commit )
+ " " split1 [ "commit" expect-string ] [ string>number read ] bi*
+ utf8 [
+ commit new parse-commit-lines
+ ] with-byte-reader ;
+
+
+
+: parse-tree-field ( obj parameter -- obj )
+ [ "\r\n" read-until* ] dip {
+ { "tree" [ >>tree ] }
+ { "parent" [ >>parents ] }
+ { "author" [ >>author ] }
+ { "committer" [ >>committer ] }
+ [ unknown-field ]
+ } case ;
+
+: parse-tree-lines ( obj -- obj )
+ "\s\n" read-until {
+ { CHAR: \s [ parse-tree-field parse-tree-lines ] }
+ { CHAR: \n [ drop contents >>message ] }
+ [ unexpected-text ]
+ } case ;
+
+
+ERROR: key-already-set value key assoc ;
+: set-at-once ( value key assoc -- )
+ 2dup key? [ key-already-set ] [ set-at ] if ;
+
+: parse-object-line>assoc ( hashtable -- hashtable )
+ "\s\n" read-until {
+ { CHAR: \s [ [ "\r\n" read-until* ] dip pick over "parent" = [ push-at ] [ set-at-once ] if parse-object-line>assoc ] }
+ { CHAR: \n [ drop contents "message" pick set-at ] }
+ } case ;
+
+: assoc>commit ( assoc -- commit )
+ [ commit new ] dip {
+ [ "tree" of >>tree ]
+ [ "parent" of >>parents ]
+ [ "author" of >>author ]
+ [ "committer" of >>committer ]
+ [ "message" of >>message ]
+ } cleave ;
+
+ERROR: unknown-git-object obj ;
+: assoc>git-object ( assoc -- git-object )
+ {
+ { [ "committer" over key? ] [ assoc>commit ] }
+ [ unknown-git-object ]
+ } cond ;
+
+: parse-object-bytes>assoc ( obj -- hashtable )
+ utf8 [
+ H{ } clone parse-object-line>assoc assoc>git-object
+ ] with-byte-reader ;
+
+
+: parse-tree ( bytes -- commit )
+ [ tree new ] dip
+ utf8 [
+ parse-tree-lines
+ ] with-byte-reader ;
+
+: parse-object ( bytes -- git-obj )
+ utf8 [
+ { 0 } read-until 0 = drop dup " " split1 drop {
+ { "blob" [ "unimplemented blob parsing" throw ] }
+ { "commit" [ parse-commit ] }
+ { "tree" [ parse-tree ] }
+ [ unknown-git-object ]
+ } case
+ ] with-byte-reader ;
+
+ERROR: idx-v1-unsupported ;
+
+TUPLE: idx version table triples packfile-sha1 idx-sha1 ;
+CONSTRUCTOR: <idx> idx ( version table triples packfile-sha1 idx-sha1 -- obj ) ;
+! sha1, crc32, offset
+
+: parse-idx-v2 ( -- idx )
+ 4 read be>
+ 256 4 * read 4 group [ be> ] map
+ dup last
+ [ [ 20 read bytes>hex-string ] replicate ]
+ [ [ 4 read ] replicate ]
+ [ [ 4 read be> ] replicate ] tri 3array flip
+ 20 read bytes>hex-string
+ 20 read bytes>hex-string <idx> ;
+
+: parse-idx ( path -- idx )
+ binary [
+ 4 read be> {
+ { 0xff744f63 [ parse-idx-v2 ] }
+ [ idx-v1-unsupported ]
+ } case
+ ] with-file-reader ;
+
+SYMBOL: #bits
+
+: read-type-length ( -- pair )
+ 0 #bits [
+ read1*
+ [ -4 shift 3 bits ] [ 4 bits ] [ ] tri
+ 0x80 mask? [
+ #bits [ 4 + ] change
+ [
+ read1* [
+ 7 bits #bits get shift bitor
+ #bits [ 7 + ] change
+ ] [ 0x80 mask? ] bi
+ ] loop
+ ] when 2array
+ ] with-variable ;
+
+: read-be-length ( -- length )
+ read1* dup 0x80 mask? [
+ 7 bits [
+ read1*
+ [ [ 1 + 7 shift ] [ 7 bits ] bi* bitor ]
+ [ 0x80 mask? ] bi
+ ] loop
+ ] when ;
+
+: read-le-length ( -- length )
+ read1* dup 0x80 mask? [
+ 7 bits [
+ read1*
+ [ 7 bits 7 shift bitor ]
+ [ 0x80 mask? ] bi
+ ] loop
+ ] when ;
+
+DEFER: git-object-from-pack
+
+TUPLE: insert bytes ;
+CONSTRUCTOR: <insert> insert ( bytes -- insert ) ;
+TUPLE: copy offset size ;
+CONSTRUCTOR: <copy> copy ( offset size -- copy ) ;
+
+: parse-delta ( -- delta/f )
+ read1 [
+ dup 0x80 mask? not [
+ 7 bits read <insert>
+ ] [
+ [ 0 0 ] dip
+
+ dup 0x01 mask? [
+ [ read1* bitor ] 2dip
+ ] when
+
+ dup 0x02 mask? [
+ [ read1* 8 shift bitor ] 2dip
+ ] when
+
+ dup 0x04 mask? [
+ [ read1* 16 shift bitor ] 2dip
+ ] when
+
+ dup 0x08 mask? [
+ [ read1* 24 shift bitor ] 2dip
+ ] when
+
+ dup 0x10 mask? [
+ [ read1* bitor ] dip
+ ] when
+
+ dup 0x20 mask? [
+ [ read1* 8 shift bitor ] dip
+ ] when
+
+ dup 0x40 mask? [
+ [ read1* 16 shift bitor ] dip
+ ] when
+
+ drop [ 65536 ] when-zero
+ <copy>
+ ] if
+ ] [
+ f
+ ] if* ;
+
+: parse-deltas ( bytes -- deltas )
+ binary [
+ read-le-length
+ read-le-length
+ [ parse-delta ] loop>array 3array
+ ] with-byte-reader ;
+
+ERROR: unknown-delta-operation op ;
+
+: apply-delta ( delta -- )
+ {
+ { [ dup insert? ] [ bytes>> write ] }
+ { [ dup copy? ] [ [ offset>> seek-absolute seek-input ] [ size>> read write ] bi ] }
+ [ unknown-delta-operation ]
+ } cond ;
+
+: do-deltas ( bytes delta-bytes -- bytes' )
+ [ binary ] 2dip '[
+ _ binary [
+ _ parse-deltas third [ apply-delta ] each
+ ] with-byte-reader
+ ] with-byte-writer ;
+
+
+ERROR: unsupported-packed-raw-type type ;
+
+: read-packed-raw ( -- string )
+ read-type-length first2 swap {
+ { 1 [ 256 + read uncompress ] }
+ [ unsupported-packed-raw-type ]
+ } case ;
+
+SYMBOL: initial-offset
+
+: read-offset-delta ( size -- obj )
+ [ read-be-length neg initial-offset get + ] dip 256 + read uncompress
+ [ seek-absolute seek-input read-packed-raw ] dip 2array ;
+
+: read-sha1-delta ( size -- obj )
+ [ 20 read bytes>hex-string git-object-from-pack ] dip read uncompress 2array ;
+
+! XXX: actual length is stored in the gzip header
+! We add 256 instead of using it for now.
+: read-packed ( -- obj/f )
+ tell-input initial-offset [
+ read-type-length first2 swap {
+ { 1 [ 256 + read uncompress parse-object ] }
+ { 6 [ read-offset-delta first2 do-deltas parse-object-bytes>assoc ] }
+ ! { 7 [ B read-sha1-delta ] }
+ [ number>string "unknown packed type: " prepend throw ]
+ } case
+ ] with-variable ;
+
+: parse-packed-object ( sha1 offset -- obj )
+ [ make-pack-path binary ] dip '[
+ input-stream [ <peek-stream> ] change
+ _ seek-absolute seek-input read-packed
+ ] with-file-reader ;
+
+! http://stackoverflow.com/questions/18010820/git-the-meaning-of-object-size-returned-by-git-verify-pack
+TUPLE: pack magic version count objects sha1 ;
+: parse-pack ( path -- pack )
+ binary [
+ input-stream [ <peek-stream> ] change
+ 4 read >string
+ 4 read be>
+ 4 read be> 3array
+ [ peek1 ] [ read-packed ] produce 2array
+ ] with-file-reader ;
+
+: git-read-idx ( sha -- obj )
+ make-idx-path parse-idx ;
+
+! Broken for now
+! : git-read-pack ( sha -- obj ) make-pack-path parse-pack ;
+
+: parsed-idx>hash ( seq -- hash )
+ H{ } clone [
+ '[
+ [ packfile-sha1>> ]
+ [ triples>> ] bi
+ [ first3 rot [ 3array ] dip _ set-at ] with each
+ ] each
+ ] keep ;
+
+MEMO: git-parse-all-idx ( -- seq )
+ "objects/pack/" make-git-path qualified-directory-files
+ [ ".idx" tail? ] filter
+ [ parse-idx ] map
+ parsed-idx>hash ;
+
+ERROR: no-pack-for sha1 ;
+
+: find-pack-for ( sha1 -- triple )
+ git-parse-all-idx ?at [ no-pack-for ] unless ;
+
+: git-object-from-pack ( sha1 -- pack )
+ [ find-pack-for [ first ] [ third ] bi parse-packed-object ] keep >>hash ;
+
+: git-object-contents ( hash -- contents )
+ make-object-path binary file-contents uncompress ;
+
+: git-read-object ( sha -- obj )
+ dup git-unpacked-object-exists? [
+ [ git-object-contents parse-object ] keep >>hash
+ ] [
+ git-object-from-pack
+ ] if ;
+
+! !: git-object-contents ( hash -- contents )
+ ! make-object-path ! binary file-contents uncompress ;
+ ! [ git-read-object ] [ git-object-from-pack ] if ;
+
+: parsed-idx>hash2 ( seq -- hash )
+ [
+ [ triples>> [ [ drop f ] [ first ] bi ] [ set-at ] sequence>hashtable ]
+ [ packfile-sha1>> ] bi
+ ] [ set-at ] sequence>hashtable ; inline
+
+ERROR: expected-ref got ;
+
+: parse-ref-line ( string -- string' )
+ " " split1 [
+ dup "ref:" = [ drop ] [ expected-ref ] if
+ ] dip ;
+
+: list-refs ( -- seq )
+ current-git-directory "refs/" append-path recursive-directory-files ;
+
+: remote-refs-dirs ( -- seq )
+ "remotes" make-refs-path directory-files ;
+
+: ref-contents ( str -- line ) make-refs-path git-line ;
+: git-stash-ref-sha1 ( -- contents ) "stash" ref-contents ;
+: git-ref ( ref -- sha1 ) git-line parse-ref-line ;
+: git-head-ref ( -- sha1 ) "HEAD" git-ref ;
+: git-log-for-ref ( ref -- log ) git-line git-read-object ;
+: git-head-object ( -- commit ) git-head-ref git-log-for-ref ;
+: git-config ( -- config )
+ "config" make-git-path ;
+
+
+SYMBOL: parents
+ERROR: repeated-parent-hash hash ;
+
+: git-log ( -- log )
+ H{ } clone parents [
+ git-head-object [
+ parents>> dup string? [ random ] unless [
+ ! [ parents get 2dup key? [ repeated-parent-hash ] when dupd set-at ] keep
+ ! dup "parent: " prepend print flush yield
+ dup git-unpacked-object-exists?
+ [ git-read-object ] [ git-object-from-pack ] if
+ ] [ f ] if*
+ ] follow
+ ] with-variable ;
--- /dev/null
+CONSTANT: OBJ_COMMIT 1
+CONSTANT: OBJ_TREE 2
+CONSTANT: OBJ_BLOB 3
+CONSTANT: OBJ_TAG 4
+CONSTANT: OBJ_OFS_DELTA 6
+CONSTANT: OBJ_REF_DELTA 7
+
+"/Users/erg/factor" set-current-directory
+"3dff14e2f3d0c8db662a8c6aeb5dbd427f4258eb" git-read-pack
+
+"/Users/erg/factor" set-current-directory
+git-log
+
+"/Users/erg/factor" set-current-directory
+"401597a387add5b52111d1dd954d6250ee2b2688" git-object-from-pack
+
+git verify-pack -v .git/objects/pack/pack-816d07912ac9f9b463f89b7e663298e3c8fedda5.pack | grep a6e0867b
+a6e0867b2222f3b0976e9aac6539fe8f12a552e2 commit 51 63 12938 1 8000d6670e1abdbaeebc4452c6cccbec68069ca1
+! problem: a6e0867b2222f3b0976e9aac6539fe8f12a552e2
+
+! investigate:
+http://stackoverflow.com/questions/9478023/is-the-git-binary-diff-algorithm-delta-storage-standardized/9478566#9478566
+
+http://stackoverflow.com/questions/801577/how-to-recover-git-objects-damaged-by-hard-disk-failure
+git ls-tree
+
+! eh
+http://schacon.github.io/git/technical/pack-format.txt
+https://schacon.github.io/gitbook/7_the_packfile.html
+
+! most useful doc:
+http://git.rsbx.net/Documents/Git_Data_Formats.txt
+
+! git show:
+git show -s --pretty=raw 2ca509a8fe681d58f80d402ea9da2be20b9ab0a0
+
+! git add
+git add -p # parts of files
+
+! git reset
+git merge --abort is alias for git reset --merge
+
+! Merge strategies:
+octopus: git merge fixes enhancements # two branches merging
+git merge --no-commit maint # merge maint into current branch, but do not make a commit yet
+http://git-scm.com/docs/git-merge
+http://stackoverflow.com/questions/161813/fix-merge-conflicts-in-git?rq=1
+
+# common base:
+git show :1:_widget.html.erb
+# 'ours'
+git show :2:_widget.html.erb
+# 'theirs'
+git show :3:_widget.html.erb
+
+git show :3:_widget.html.erb >_widget.html.erb
+git add _widget.html.erb
+aka
+git checkout --theirs _widget.html.erb
+
+
+
+Guys, "ours" and "theirs" is relative to whether or not you are merging or rebasing. If you're merging, then "ours" means the branch you're merging into, and "theirs" is the branch you're merging in. When you're rebasing, then "ours" means the commits you're rebasing onto, while "theirs" refers to the commits that you want to rebase. – Cupcake May 26 '14 at 4:27
+
+
+! random
+https://github.com/libgit2/libgit2/blob/091165c53b2bcd5d41fb71d43ed5a23a3d96bf5d/docs/diff-internals.md
+https://github.com/schacon/git-server/blob/master/git-server.rb
+
+https://git-scm.com/blog
+
+https://github.com/gitchain/gitchain/blob/2baefefd1795b358c98335f120738b60966fa09d/git/delta.go
+https://www.kernel.org/pub/software/scm/git/docs/user-manual.html#git-concepts
+
+! graphs in terminal:
+http://stackoverflow.com/questions/1064361/unable-to-show-a-git-tree-in-terminal
+
+git-daemon:
+ git daemon --reuseaddr --verbose --base-path=. --export-all
+$> export GIT_TRACE_PACKET=1
+ git ls-remote git://127.0.0.1/git-bottom-up
+
+
+
+raw git:
+https://schacon.github.io/gitbook/7_raw_git.html
+
+# write object
+git hash-object -w myfile.txt
+
+-----------------------------------
+Now lets say you want to create a tree from your new objects. The git mktree command makes it pretty simple to generate new tree objects from git ls-tree formatted output. For example, if you write the following to a file named '/tmp/tree.txt' :
+
+100644 blob 6ff87c4664981e4397625791c8ea3bbb5f2279a3 file1
+100644 blob 3bb0e8592a41ae3185ee32266c860714980dbed7 file2
+
+$ cat /tmp/tree.txt | git mk-tree
+f66a66ab6a7bfe86d52a66516ace212efa00fe1f
+
+100644 blob 6ff87c4664981e4397625791c8ea3bbb5f2279a3 file1-copy
+040000 tree f66a66ab6a7bfe86d52a66516ace212efa00fe1f our_files
+
+$ cat /tmp/newtree.txt | git mk-tree
+5bac6559179bd543a024d6d187692343e2d8ae83
+
+
+.
+|-- file1-copy
+`-- our_files
+ |-- file1
+ `-- file2
+
+1 directory, 3 files
+
+---------------------------------------------
+
+
+
+$ export GIT_INDEX_FILE=/tmp/index
+$ git read-tree --prefix=copy1/ 5bac6559
+$ git read-tree --prefix=copy2/ 5bac6559
+$ git write-tree
+bb2fa6de7625322322382215d9ea78cfe76508c1
+
+$>git ls-tree bb2fa
+040000 tree 5bac6559179bd543a024d6d187692343e2d8ae83 copy1
+040000 tree 5bac6559179bd543a024d6d187692343e2d8ae83 copy2
+
+-------------------------------
+
+
+GIT_AUTHOR_NAME
+GIT_AUTHOR_EMAIL
+GIT_AUTHOR_DATE
+GIT_COMMITTER_NAME
+GIT_COMMITTER_EMAIL
+GIT_COMMITTER_DATE
+$ git commit-tree bb2fa < /tmp/message
+a5f85ba5875917319471dfd98dfc636c1dc65650
+
+$ git update-ref refs/heads/master a5f85ba5875917319471dfd98dfc636c1dc65650
+
+
+https://github.com/magit/magit
+
+https://www.kernel.org/pub/software/scm/git/docs/user-manual.html
projects / factor.git / commitdiff