getfile and putfile functions
[opensuse:obs-git.git] / bs_srcserver_gitonly
1 #!/usr/bin/perl -w
2
3 package bs_srcserver_gitonly;
4
5 use strict;
6
7 my $GIT_HASH_LENGTH = 40 ;
8 my $gittempdir = "$srcrep/:temp" ;
9
10 # lists all files from given package and revision identified by git commit hash
11 # TODO there are still some cases that will generate MD5s, not hashes...
12
13 sub lsrep {
14   my ($projid, $packid, $srchash) = @_;
15   die("no such revision\n") unless defined $srchash;
16   local *F;
17   die("bad packid\n") if $packid =~ /\// || $packid =~ /^\./;
18
19   # TODO: check what exactly means these special cases, i've just changed the variable name...
20   if ($srchash eq 'upload') {
21     open(F, '<', "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS") || die("$packid/$srchash-$packid: not in repository\n");
22   } elsif ($srcmd5 eq 'pattern') {
23     open(F, '<', "$projectsdir/$projid.pkg/pattern-MD5SUMS") || return {};
24     # TODO: this is awful... and what to do with empty md5 in git version?
25   } elsif ($srchash eq 'empty' || $srchash eq 'd41d8cd98f00b204e9800998ecf8427e') { 
26     return {};
27   } else {
28     # this reads the file information from git
29     if ($srchash !~ /^[0-9a-f]{$GIT_HASH_LENGTH}$/) {
30       die("bad srchash '$srchash'\n");
31     }
32
33     $repopath = "$srcrep/$projid/$packid/"
34     my @gitfiles = `git ls-tree $srchash | cut -d' ' -f 3`;
35     if ($? != 0 ) {
36       die("$packid/$srchash-$packid: not in repository\n");
37     }
38
39     chomp @gitfiles;
40
41     return {map {substr($_, $GIT_HASH_LENGTH + 1) => substr($_, 0, $GIT_HASH_LENGTH)} @gitfiles};
42   }
43   my @files = <F>;
44   close F;
45   chomp @files;
46   return {map {substr($_, 34) => substr($_, 0, 32)} @files};
47 }
48
49
50 # creates *-MD5SUMS files. In git backend only for special cases not in source repository
51 # for these cases returns srcmd5, for normal sources an empty string, since hashes are needed
52 # at commit only
53 sub addmeta {
54   my ($projid, $packid, $files, $rev) = @_;
55
56   # calculate new meta sum
57   my $meta = '';
58   $meta .= "$files->{$_}  $_\n" for sort keys %$files;
59   my $srcmd5 = Digest::MD5::md5_hex($meta);
60   if ($rev && $rev eq 'upload') {
61     mkdir_p("$srcrep/:upload");
62     mkdir_p("$projectsdir/$projid.pkg");
63     writestr("$srcrep/:upload/$$", "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS", $meta);
64   } elsif ($rev && $rev eq 'pattern') {
65     if ($meta ne '') {
66       mkdir_p("$srcrep/:upload");
67       mkdir_p("$projectsdir/$projid.pkg");
68       writestr("$srcrep/:upload/$$", "$projectsdir/$projid.pkg/pattern-MD5SUMS", $meta);
69     } else {
70       unlink("$projectsdir/$projid.pkg/pattern-MD5SUMS");
71     }
72   } else {
73     # normal packages don't need this function
74     return "";
75   }
76
77   return $srcmd5;
78 }
79
80
81 sub putinsrcrep {
82   my ($projid, $packid, $tmpfile, $filename) = @_;
83
84   $githash = `git --git-dir="$srcrep/$projid/$packid/" hash-object -w $tmpfile`;
85   if ($? != 0 ) {
86     die("git hash-object failed");
87   }
88
89   unlink($tmpfile);
90
91   return $githash;
92 }
93
94 # Commits files previously prepared into repository
95 # files param is a reference to hash of form { filename => hash }
96 sub commitfiles {
97   my ($cgi, $projid, $packid, $files) = @_;
98
99   for my $filename (keys %$files) {
100     if ( system( "git --git-dir=\"$srcrep/$projid/$packid/\" update-index --cacheinfo 0644 $files->{$filename} $filename" ) != 0 ) {
101       die("failed git update-index");
102     }
103   }
104
105   if ( system( "git --git-dir=\"$srcrep/$projid/$packid/\" commit" ) != 0 ) {
106     die("git commit failed");
107   }
108
109   $githash = `git --git-dir="$srcrep/$projid/$packid/" log | head -n 1 | cut -f 2 -d ' '`;
110
111   return $githash unless ($? != 0);
112   die( "cannot get git hash" );
113 }
114
115 # saves the file from project and package with specified hash into some temporary location
116 # returns the filename
117 sub fetchgitfile {
118   my ($projid, $packid, $githash) = @_;
119
120   mkdir_p("$gittempdir");
121   $tmpfilename = "$gittempdir/$githash-$$";
122
123   if ( system( "git --git-dir=\"$srcrep/$projid/$packid/\" cat-file -p $githash > $tmpfilename" ) != 0 ) {
124     die("git cat-file failed");
125   }
126
127   return $tmpfilename;
128 }
129
130 # TODO: this needs review
131 sub addrev {
132   my ($projid, $packid, $files, $user, $comment, $target) = @_;
133   die("project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
134   if ($packid eq '_pattern') {
135     my $srcmd5 = addmeta($projid, $packid, $files, 'pattern');
136     bs_srcserver_common::notify_repservers('project', $projid);
137
138     return {'rev' => 'pattern', 'srcmd5' => $srcmd5};
139   }
140   die("package '$packid' is read-only\n") if $packid =~ /^_product:/;
141   die("package '$packid' does not exist\n") unless -e "$projectsdir/$projid.pkg/$packid.xml";
142   if ($target && $target eq 'upload') {
143     my $srcmd5 = addmeta($projid, $packid, $files, 'upload');
144     my $filename = (keys %$files)[0];
145     BSHermes::notify("SRCSRV_UPLOAD", {project => $projid, package => $packid, filename => $filename, user => $user});
146     return {'rev' => 'upload', 'srcmd5' => $srcmd5};
147   } elsif ($target && $target eq 'repository') {
148     # repository only upload.
149     return {'rev' => 'repository'};
150   } elsif (defined($target)) {
151     # internal version only upload.
152     # TODO: obs-git: this might be a problem - addmeta probably returns '' here...
153     my $srcmd5 = addmeta($projid, $packid, $files);
154     return {'rev' => $srcmd5, 'srcmd5' => $srcmd5};
155   }
156   die("bad projid\n") if $projid =~ /\// || $projid =~ /^\./;
157   die("bad packid\n") if $packid =~ /\// || $packid =~ /^\./;
158   die("bad files\n") if grep {/\//} keys %$files;
159   die("bad files\n") if grep {!/^[0-9a-f]{32}$/} values %$files;
160
161   # TODO: obs-git: handle this correctly
162   if ($packid eq '_product') {
163     expandproduct($projid, $packid, $files, $user) || die("product conversation failed\n");
164   }
165
166   # get version/release from rpm spec/deb dsc/kiwi xml file
167   my $version = 'unknown';
168   my $release;
169   my $bconf = Build::read_config('noarch');
170   for my $type ('spec', 'dsc', 'kiwi') {
171     my $file = bs_srcserver_common_notsure::findfile($projid, $packid, undef, $type, $files);
172     next unless defined $file;
173     my $tmpgitfile = fetchgitfile($projid, $packid, $files->{$file});
174     my $d = Build::parse($bconf, $tmpgitfile );
175     unlink($tmpgitfile);
176     next unless defined $d->{'version'};
177     $version = $d->{'version'};
178     $release = $d->{'release'} if defined $d->{'release'};
179     last;
180   }
181   if (defined($release)) {
182     if ($release =~ /(\d+)\.<B_CNT>/) {
183       $release = $1;
184     } elsif ($release =~ /<RELEASE(\d+)>/) {
185       $release = $1;
186     } elsif ($release =~ /^(\d+)/) {
187       $release = $1;
188     } else {
189       $release = '0';
190     }
191   }
192   $release ||= '0';
193   #my $srcmd5 = addmeta($projid, $packid, $files);
194   # TODO: maybe can be impemented inside addmeta, but better solution would be outside
195   my $githash = commitfiles($projid, $packid, $files);
196   my $rev = {'srcmd5' => $githash, 'time' => time(), 'user' => $user, 'comment' => $comment, 'version' => $version, 'vrev' => $release};
197
198   # TODO: these 'srcmd5' strings are names in files - they could be renamed, but it would have to be in whole system
199   my $rev_old = BSFileDB::fdb_getlast("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay);
200   $rev_old ||= {'srcmd5' => 'empty'};
201   my $files_old = lsrep($projid, $packid, $rev_old->{'srcmd5'});
202   my $filestr = BSHermes::generate_commit_flist($files_old, $files);
203
204   $rev = BSFileDB::fdb_add_i2("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, $rev, 'vrev', 'version', $version);
205   BSHermes::notify("SRCSRV_COMMIT", {project => $projid, package => $packid, files => $filestr, rev => $rev->{'rev'}, user => $user, comment => $comment});
206
207   # kill upload revision as we did a real commit
208   unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
209
210   bs_srcserver_common::notify_repservers('package', $projid, $packid);
211   return $rev;
212 }
213
214 sub getfile {
215   my ($cgi, $projid, $packid, $filename) = @_;
216   die("no filename\n") unless defined($filename) && $filename ne '';
217   die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
218   # TODO: check use of getrev function
219   my $rev = bs_srcserver_common_notsure::getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
220   die("$filename: no such project/package\n") unless $rev;
221   # TODO: check that srcmd5 field - since it is also name of som file structure, it will hav to stay there with this bad name
222   my $files = lsrep($projid, $packid, $rev->{'srcmd5'});
223   die("$filename: no such file\n") unless $files->{$filename};
224
225   my $tmpgitfile = fetchgitfile($projid, $packid, $files->{$filename});
226   my @s = stat($tmpgitfilename);
227   die("temporary git file for: $srcrep/$packid/$files->{$filename}-$filename: $!\n") unless @s;
228   BSServer::reply_file($tmpgitfilename, "Content-Length: $s[7]");
229   unlink($tmpgitfilename);
230   return undef;
231 }
232
233 sub putfile {
234   my ($cgi, $projid, $packid, $filename) = @_;
235   die("no filename\n") unless defined($filename) && $filename ne '';
236   die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
237   my $rev = bs_srcserver_common_notsure::getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
238   die("unknown project/package\n") unless $rev;
239   mkdir_p("$gittempdir");
240   my $uploaded = BSServer::read_file("$gittempdir/$$");
241   die("upload failed\n") unless $uploaded;
242
243   # puts objects into repository and deletes temporary file
244   my $githash = putinsrcrep($projid, $packid, "$gittempdir/$$",$filename);
245   my $srname = "$uploaded->{'md5'}-$filename";
246   if (! -e "$srcrep/$packid/$srname") {
247     mkdir_p "$srcrep/$packid";
248     rename("$srcrep/:upload/$$", "$srcrep/$packid/$srname") || die("rename $srcrep/:upload/$$ $srcrep/$packid/$srname: $!\n");
249   } else {
250     #already there, all the upload work was unneeded...
251     unlink("$srcrep/:upload/$$");
252   }
253   # create new meta file
254   # TODO: again, srcmd5 name...
255   my $files = lsrep($projid, $packid, $rev->{'srcmd5'});
256   $files->{$filename} = $githash;
257   # TODO: toto asi zmazat: 
258   #$files = bs_srcserver_bsdbonly_links::keeplink($cgi, $projid, $packid, $files) if $cgi->{'bs_srcserver_bsdbonly_links::keeplink'};
259   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
260   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
261   $rev = addrev($projid, $packid, $files, $user, $comment, $cgi->{'rev'});
262   return ($rev, $BSXML::revision);
263 }