THIS IS A TEST INSTANCE ONLY! REPOSITORIES CAN BE DELETED AT ANY TIME!

Git Source Code Mirror - This is a publish-only repository and all pull requests are ignored. Please follow Documentation/SubmittingPatches procedure for any of your improvements.
git
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

5106 lines
159KB

  1. #!/usr/bin/perl
  2. ####
  3. #### This application is a CVS emulation layer for git.
  4. #### It is intended for clients to connect over SSH.
  5. #### See the documentation for more details.
  6. ####
  7. #### Copyright The Open University UK - 2006.
  8. ####
  9. #### Authors: Martyn Smith <martyn@catalyst.net.nz>
  10. #### Martin Langhoff <martin@laptop.org>
  11. ####
  12. ####
  13. #### Released under the GNU Public License, version 2.
  14. ####
  15. ####
  16. use 5.008;
  17. use strict;
  18. use warnings;
  19. use bytes;
  20. use Fcntl;
  21. use File::Temp qw/tempdir tempfile/;
  22. use File::Path qw/rmtree/;
  23. use File::Basename;
  24. use Getopt::Long qw(:config require_order no_ignore_case);
  25. my $VERSION = '@@GIT_VERSION@@';
  26. my $log = GITCVS::log->new();
  27. my $cfg;
  28. my $DATE_LIST = {
  29. Jan => "01",
  30. Feb => "02",
  31. Mar => "03",
  32. Apr => "04",
  33. May => "05",
  34. Jun => "06",
  35. Jul => "07",
  36. Aug => "08",
  37. Sep => "09",
  38. Oct => "10",
  39. Nov => "11",
  40. Dec => "12",
  41. };
  42. # Enable autoflush for STDOUT (otherwise the whole thing falls apart)
  43. $| = 1;
  44. #### Definition and mappings of functions ####
  45. # NOTE: Despite the existence of req_CATCHALL and req_EMPTY unimplemented
  46. # requests, this list is incomplete. It is missing many rarer/optional
  47. # requests. Perhaps some clients require a claim of support for
  48. # these specific requests for main functionality to work?
  49. my $methods = {
  50. 'Root' => \&req_Root,
  51. 'Valid-responses' => \&req_Validresponses,
  52. 'valid-requests' => \&req_validrequests,
  53. 'Directory' => \&req_Directory,
  54. 'Sticky' => \&req_Sticky,
  55. 'Entry' => \&req_Entry,
  56. 'Modified' => \&req_Modified,
  57. 'Unchanged' => \&req_Unchanged,
  58. 'Questionable' => \&req_Questionable,
  59. 'Argument' => \&req_Argument,
  60. 'Argumentx' => \&req_Argument,
  61. 'expand-modules' => \&req_expandmodules,
  62. 'add' => \&req_add,
  63. 'remove' => \&req_remove,
  64. 'co' => \&req_co,
  65. 'update' => \&req_update,
  66. 'ci' => \&req_ci,
  67. 'diff' => \&req_diff,
  68. 'log' => \&req_log,
  69. 'rlog' => \&req_log,
  70. 'tag' => \&req_CATCHALL,
  71. 'status' => \&req_status,
  72. 'admin' => \&req_CATCHALL,
  73. 'history' => \&req_CATCHALL,
  74. 'watchers' => \&req_EMPTY,
  75. 'editors' => \&req_EMPTY,
  76. 'noop' => \&req_EMPTY,
  77. 'annotate' => \&req_annotate,
  78. 'Global_option' => \&req_Globaloption,
  79. };
  80. ##############################################
  81. # $state holds all the bits of information the clients sends us that could
  82. # potentially be useful when it comes to actually _doing_ something.
  83. my $state = { prependdir => '' };
  84. # Work is for managing temporary working directory
  85. my $work =
  86. {
  87. state => undef, # undef, 1 (empty), 2 (with stuff)
  88. workDir => undef,
  89. index => undef,
  90. emptyDir => undef,
  91. tmpDir => undef
  92. };
  93. $log->info("--------------- STARTING -----------------");
  94. my $usage =
  95. "usage: git cvsserver [options] [pserver|server] [<directory> ...]\n".
  96. " --base-path <path> : Prepend to requested CVSROOT\n".
  97. " Can be read from GIT_CVSSERVER_BASE_PATH\n".
  98. " --strict-paths : Don't allow recursing into subdirectories\n".
  99. " --export-all : Don't check for gitcvs.enabled in config\n".
  100. " --version, -V : Print version information and exit\n".
  101. " -h, -H : Print usage information and exit\n".
  102. "\n".
  103. "<directory> ... is a list of allowed directories. If no directories\n".
  104. "are given, all are allowed. This is an additional restriction, gitcvs\n".
  105. "access still needs to be enabled by the gitcvs.enabled config option.\n".
  106. "Alternately, one directory may be specified in GIT_CVSSERVER_ROOT.\n";
  107. my @opts = ( 'h|H', 'version|V',
  108. 'base-path=s', 'strict-paths', 'export-all' );
  109. GetOptions( $state, @opts )
  110. or die $usage;
  111. if ($state->{version}) {
  112. print "git-cvsserver version $VERSION\n";
  113. exit;
  114. }
  115. if ($state->{help}) {
  116. print $usage;
  117. exit;
  118. }
  119. my $TEMP_DIR = tempdir( CLEANUP => 1 );
  120. $log->debug("Temporary directory is '$TEMP_DIR'");
  121. $state->{method} = 'ext';
  122. if (@ARGV) {
  123. if ($ARGV[0] eq 'pserver') {
  124. $state->{method} = 'pserver';
  125. shift @ARGV;
  126. } elsif ($ARGV[0] eq 'server') {
  127. shift @ARGV;
  128. }
  129. }
  130. # everything else is a directory
  131. $state->{allowed_roots} = [ @ARGV ];
  132. # don't export the whole system unless the users requests it
  133. if ($state->{'export-all'} && !@{$state->{allowed_roots}}) {
  134. die "--export-all can only be used together with an explicit whitelist\n";
  135. }
  136. # Environment handling for running under git-shell
  137. if (exists $ENV{GIT_CVSSERVER_BASE_PATH}) {
  138. if ($state->{'base-path'}) {
  139. die "Cannot specify base path both ways.\n";
  140. }
  141. my $base_path = $ENV{GIT_CVSSERVER_BASE_PATH};
  142. $state->{'base-path'} = $base_path;
  143. $log->debug("Picked up base path '$base_path' from environment.\n");
  144. }
  145. if (exists $ENV{GIT_CVSSERVER_ROOT}) {
  146. if (@{$state->{allowed_roots}}) {
  147. die "Cannot specify roots both ways: @ARGV\n";
  148. }
  149. my $allowed_root = $ENV{GIT_CVSSERVER_ROOT};
  150. $state->{allowed_roots} = [ $allowed_root ];
  151. $log->debug("Picked up allowed root '$allowed_root' from environment.\n");
  152. }
  153. # if we are called with a pserver argument,
  154. # deal with the authentication cat before entering the
  155. # main loop
  156. if ($state->{method} eq 'pserver') {
  157. my $line = <STDIN>; chomp $line;
  158. unless( $line =~ /^BEGIN (AUTH|VERIFICATION) REQUEST$/) {
  159. die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
  160. }
  161. my $request = $1;
  162. $line = <STDIN>; chomp $line;
  163. unless (req_Root('root', $line)) { # reuse Root
  164. print "E Invalid root $line \n";
  165. exit 1;
  166. }
  167. $line = <STDIN>; chomp $line;
  168. my $user = $line;
  169. $line = <STDIN>; chomp $line;
  170. my $password = $line;
  171. if ($user eq 'anonymous') {
  172. # "A" will be 1 byte, use length instead in case the
  173. # encryption method ever changes (yeah, right!)
  174. if (length($password) > 1 ) {
  175. print "E Don't supply a password for the `anonymous' user\n";
  176. print "I HATE YOU\n";
  177. exit 1;
  178. }
  179. # Fall through to LOVE
  180. } else {
  181. # Trying to authenticate a user
  182. if (not exists $cfg->{gitcvs}->{authdb}) {
  183. print "E the repo config file needs a [gitcvs] section with an 'authdb' parameter set to the filename of the authentication database\n";
  184. print "I HATE YOU\n";
  185. exit 1;
  186. }
  187. my $authdb = $cfg->{gitcvs}->{authdb};
  188. unless (-e $authdb) {
  189. print "E The authentication database specified in [gitcvs.authdb] does not exist\n";
  190. print "I HATE YOU\n";
  191. exit 1;
  192. }
  193. my $auth_ok;
  194. open my $passwd, "<", $authdb or die $!;
  195. while (<$passwd>) {
  196. if (m{^\Q$user\E:(.*)}) {
  197. if (crypt($user, descramble($password)) eq $1) {
  198. $auth_ok = 1;
  199. }
  200. };
  201. }
  202. close $passwd;
  203. unless ($auth_ok) {
  204. print "I HATE YOU\n";
  205. exit 1;
  206. }
  207. # Fall through to LOVE
  208. }
  209. # For checking whether the user is anonymous on commit
  210. $state->{user} = $user;
  211. $line = <STDIN>; chomp $line;
  212. unless ($line eq "END $request REQUEST") {
  213. die "E Do not understand $line -- expecting END $request REQUEST\n";
  214. }
  215. print "I LOVE YOU\n";
  216. exit if $request eq 'VERIFICATION'; # cvs login
  217. # and now back to our regular programme...
  218. }
  219. # Keep going until the client closes the connection
  220. while (<STDIN>)
  221. {
  222. chomp;
  223. # Check to see if we've seen this method, and call appropriate function.
  224. if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
  225. {
  226. # use the $methods hash to call the appropriate sub for this command
  227. #$log->info("Method : $1");
  228. &{$methods->{$1}}($1,$2);
  229. } else {
  230. # log fatal because we don't understand this function. If this happens
  231. # we're fairly screwed because we don't know if the client is expecting
  232. # a response. If it is, the client will hang, we'll hang, and the whole
  233. # thing will be custard.
  234. $log->fatal("Don't understand command $_\n");
  235. die("Unknown command $_");
  236. }
  237. }
  238. $log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
  239. $log->info("--------------- FINISH -----------------");
  240. chdir '/';
  241. exit 0;
  242. # Magic catchall method.
  243. # This is the method that will handle all commands we haven't yet
  244. # implemented. It simply sends a warning to the log file indicating a
  245. # command that hasn't been implemented has been invoked.
  246. sub req_CATCHALL
  247. {
  248. my ( $cmd, $data ) = @_;
  249. $log->warn("Unhandled command : req_$cmd : $data");
  250. }
  251. # This method invariably succeeds with an empty response.
  252. sub req_EMPTY
  253. {
  254. print "ok\n";
  255. }
  256. # Root pathname \n
  257. # Response expected: no. Tell the server which CVSROOT to use. Note that
  258. # pathname is a local directory and not a fully qualified CVSROOT variable.
  259. # pathname must already exist; if creating a new root, use the init
  260. # request, not Root. pathname does not include the hostname of the server,
  261. # how to access the server, etc.; by the time the CVS protocol is in use,
  262. # connection, authentication, etc., are already taken care of. The Root
  263. # request must be sent only once, and it must be sent before any requests
  264. # other than Valid-responses, valid-requests, UseUnchanged, Set or init.
  265. sub req_Root
  266. {
  267. my ( $cmd, $data ) = @_;
  268. $log->debug("req_Root : $data");
  269. unless ($data =~ m#^/#) {
  270. print "error 1 Root must be an absolute pathname\n";
  271. return 0;
  272. }
  273. my $cvsroot = $state->{'base-path'} || '';
  274. $cvsroot =~ s#/+$##;
  275. $cvsroot .= $data;
  276. if ($state->{CVSROOT}
  277. && ($state->{CVSROOT} ne $cvsroot)) {
  278. print "error 1 Conflicting roots specified\n";
  279. return 0;
  280. }
  281. $state->{CVSROOT} = $cvsroot;
  282. $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
  283. if (@{$state->{allowed_roots}}) {
  284. my $allowed = 0;
  285. foreach my $dir (@{$state->{allowed_roots}}) {
  286. next unless $dir =~ m#^/#;
  287. $dir =~ s#/+$##;
  288. if ($state->{'strict-paths'}) {
  289. if ($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) {
  290. $allowed = 1;
  291. last;
  292. }
  293. } elsif ($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) {
  294. $allowed = 1;
  295. last;
  296. }
  297. }
  298. unless ($allowed) {
  299. print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
  300. print "E \n";
  301. print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
  302. return 0;
  303. }
  304. }
  305. unless (-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') {
  306. print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
  307. print "E \n";
  308. print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
  309. return 0;
  310. }
  311. my @gitvars = safe_pipe_capture(qw(git config -l));
  312. if ($?) {
  313. print "E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
  314. print "E \n";
  315. print "error 1 - problem executing git-config\n";
  316. return 0;
  317. }
  318. foreach my $line ( @gitvars )
  319. {
  320. next unless ( $line =~ /^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ );
  321. unless ($2) {
  322. $cfg->{$1}{$3} = $4;
  323. } else {
  324. $cfg->{$1}{$2}{$3} = $4;
  325. }
  326. }
  327. my $enabled = ($cfg->{gitcvs}{$state->{method}}{enabled}
  328. || $cfg->{gitcvs}{enabled});
  329. unless ($state->{'export-all'} ||
  330. ($enabled && $enabled =~ /^\s*(1|true|yes)\s*$/i)) {
  331. print "E GITCVS emulation needs to be enabled on this repo\n";
  332. print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
  333. print "E \n";
  334. print "error 1 GITCVS emulation disabled\n";
  335. return 0;
  336. }
  337. my $logfile = $cfg->{gitcvs}{$state->{method}}{logfile} || $cfg->{gitcvs}{logfile};
  338. if ( $logfile )
  339. {
  340. $log->setfile($logfile);
  341. } else {
  342. $log->nofile();
  343. }
  344. return 1;
  345. }
  346. # Global_option option \n
  347. # Response expected: no. Transmit one of the global options `-q', `-Q',
  348. # `-l', `-t', `-r', or `-n'. option must be one of those strings, no
  349. # variations (such as combining of options) are allowed. For graceful
  350. # handling of valid-requests, it is probably better to make new global
  351. # options separate requests, rather than trying to add them to this
  352. # request.
  353. sub req_Globaloption
  354. {
  355. my ( $cmd, $data ) = @_;
  356. $log->debug("req_Globaloption : $data");
  357. $state->{globaloptions}{$data} = 1;
  358. }
  359. # Valid-responses request-list \n
  360. # Response expected: no. Tell the server what responses the client will
  361. # accept. request-list is a space separated list of tokens.
  362. sub req_Validresponses
  363. {
  364. my ( $cmd, $data ) = @_;
  365. $log->debug("req_Validresponses : $data");
  366. # TODO : re-enable this, currently it's not particularly useful
  367. #$state->{validresponses} = [ split /\s+/, $data ];
  368. }
  369. # valid-requests \n
  370. # Response expected: yes. Ask the server to send back a Valid-requests
  371. # response.
  372. sub req_validrequests
  373. {
  374. my ( $cmd, $data ) = @_;
  375. $log->debug("req_validrequests");
  376. $log->debug("SEND : Valid-requests " . join(" ",sort keys %$methods));
  377. $log->debug("SEND : ok");
  378. print "Valid-requests " . join(" ",sort keys %$methods) . "\n";
  379. print "ok\n";
  380. }
  381. # Directory local-directory \n
  382. # Additional data: repository \n. Response expected: no. Tell the server
  383. # what directory to use. The repository should be a directory name from a
  384. # previous server response. Note that this both gives a default for Entry
  385. # and Modified and also for ci and the other commands; normal usage is to
  386. # send Directory for each directory in which there will be an Entry or
  387. # Modified, and then a final Directory for the original directory, then the
  388. # command. The local-directory is relative to the top level at which the
  389. # command is occurring (i.e. the last Directory which is sent before the
  390. # command); to indicate that top level, `.' should be sent for
  391. # local-directory.
  392. sub req_Directory
  393. {
  394. my ( $cmd, $data ) = @_;
  395. my $repository = <STDIN>;
  396. chomp $repository;
  397. $state->{localdir} = $data;
  398. $state->{repository} = $repository;
  399. $state->{path} = $repository;
  400. $state->{path} =~ s/^\Q$state->{CVSROOT}\E\///;
  401. $state->{module} = $1 if ($state->{path} =~ s/^(.*?)(\/|$)//);
  402. $state->{path} .= "/" if ( $state->{path} =~ /\S/ );
  403. $state->{directory} = $state->{localdir};
  404. $state->{directory} = "" if ( $state->{directory} eq "." );
  405. $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
  406. if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
  407. {
  408. $log->info("Setting prepend to '$state->{path}'");
  409. $state->{prependdir} = $state->{path};
  410. my %entries;
  411. foreach my $entry ( keys %{$state->{entries}} )
  412. {
  413. $entries{$state->{prependdir} . $entry} = $state->{entries}{$entry};
  414. }
  415. $state->{entries}=\%entries;
  416. my %dirMap;
  417. foreach my $dir ( keys %{$state->{dirMap}} )
  418. {
  419. $dirMap{$state->{prependdir} . $dir} = $state->{dirMap}{$dir};
  420. }
  421. $state->{dirMap}=\%dirMap;
  422. }
  423. if ( defined ( $state->{prependdir} ) )
  424. {
  425. $log->debug("Prepending '$state->{prependdir}' to state|directory");
  426. $state->{directory} = $state->{prependdir} . $state->{directory}
  427. }
  428. if ( ! defined($state->{dirMap}{$state->{directory}}) )
  429. {
  430. $state->{dirMap}{$state->{directory}} =
  431. {
  432. 'names' => {}
  433. #'tagspec' => undef
  434. };
  435. }
  436. $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
  437. }
  438. # Sticky tagspec \n
  439. # Response expected: no. Tell the server that the directory most
  440. # recently specified with Directory has a sticky tag or date
  441. # tagspec. The first character of tagspec is T for a tag, D for
  442. # a date, or some other character supplied by a Set-sticky
  443. # response from a previous request to the server. The remainder
  444. # of tagspec contains the actual tag or date, again as supplied
  445. # by Set-sticky.
  446. # The server should remember Static-directory and Sticky requests
  447. # for a particular directory; the client need not resend them each
  448. # time it sends a Directory request for a given directory. However,
  449. # the server is not obliged to remember them beyond the context
  450. # of a single command.
  451. sub req_Sticky
  452. {
  453. my ( $cmd, $tagspec ) = @_;
  454. my ( $stickyInfo );
  455. if($tagspec eq "")
  456. {
  457. # nothing
  458. }
  459. elsif($tagspec=~/^T([^ ]+)\s*$/)
  460. {
  461. $stickyInfo = { 'tag' => $1 };
  462. }
  463. elsif($tagspec=~/^D([0-9.]+)\s*$/)
  464. {
  465. $stickyInfo= { 'date' => $1 };
  466. }
  467. else
  468. {
  469. die "Unknown tag_or_date format\n";
  470. }
  471. $state->{dirMap}{$state->{directory}}{stickyInfo}=$stickyInfo;
  472. $log->debug("req_Sticky : tagspec=$tagspec repository=$state->{repository}"
  473. . " path=$state->{path} directory=$state->{directory}"
  474. . " module=$state->{module}");
  475. }
  476. # Entry entry-line \n
  477. # Response expected: no. Tell the server what version of a file is on the
  478. # local machine. The name in entry-line is a name relative to the directory
  479. # most recently specified with Directory. If the user is operating on only
  480. # some files in a directory, Entry requests for only those files need be
  481. # included. If an Entry request is sent without Modified, Is-modified, or
  482. # Unchanged, it means the file is lost (does not exist in the working
  483. # directory). If both Entry and one of Modified, Is-modified, or Unchanged
  484. # are sent for the same file, Entry must be sent first. For a given file,
  485. # one can send Modified, Is-modified, or Unchanged, but not more than one
  486. # of these three.
  487. sub req_Entry
  488. {
  489. my ( $cmd, $data ) = @_;
  490. #$log->debug("req_Entry : $data");
  491. my @data = split(/\//, $data, -1);
  492. $state->{entries}{$state->{directory}.$data[1]} = {
  493. revision => $data[2],
  494. conflict => $data[3],
  495. options => $data[4],
  496. tag_or_date => $data[5],
  497. };
  498. $state->{dirMap}{$state->{directory}}{names}{$data[1]} = 'F';
  499. $log->info("Received entry line '$data' => '" . $state->{directory} . $data[1] . "'");
  500. }
  501. # Questionable filename \n
  502. # Response expected: no. Additional data: no. Tell the server to check
  503. # whether filename should be ignored, and if not, next time the server
  504. # sends responses, send (in a M response) `?' followed by the directory and
  505. # filename. filename must not contain `/'; it needs to be a file in the
  506. # directory named by the most recent Directory request.
  507. sub req_Questionable
  508. {
  509. my ( $cmd, $data ) = @_;
  510. $log->debug("req_Questionable : $data");
  511. $state->{entries}{$state->{directory}.$data}{questionable} = 1;
  512. }
  513. # add \n
  514. # Response expected: yes. Add a file or directory. This uses any previous
  515. # Argument, Directory, Entry, or Modified requests, if they have been sent.
  516. # The last Directory sent specifies the working directory at the time of
  517. # the operation. To add a directory, send the directory to be added using
  518. # Directory and Argument requests.
  519. sub req_add
  520. {
  521. my ( $cmd, $data ) = @_;
  522. argsplit("add");
  523. my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
  524. $updater->update();
  525. my $addcount = 0;
  526. foreach my $filename ( @{$state->{args}} )
  527. {
  528. $filename = filecleanup($filename);
  529. # no -r, -A, or -D with add
  530. my $stickyInfo = resolveStickyInfo($filename);
  531. my $meta = $updater->getmeta($filename,$stickyInfo);
  532. my $wrev = revparse($filename);
  533. if ($wrev && $meta && ($wrev=~/^-/))
  534. {
  535. # previously removed file, add back
  536. $log->info("added file $filename was previously removed, send $meta->{revision}");
  537. print "MT +updated\n";
  538. print "MT text U \n";
  539. print "MT fname $filename\n";
  540. print "MT newline\n";
  541. print "MT -updated\n";
  542. unless ( $state->{globaloptions}{-n} )
  543. {
  544. my ( $filepart, $dirpart ) = filenamesplit($filename,1);
  545. print "Created $dirpart\n";
  546. print $state->{CVSROOT} . "/$state->{module}/$filename\n";
  547. # this is an "entries" line
  548. my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
  549. my $entryLine = "/$filepart/$meta->{revision}//$kopts/";
  550. $entryLine .= getStickyTagOrDate($stickyInfo);
  551. $log->debug($entryLine);
  552. print "$entryLine\n";
  553. # permissions
  554. $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
  555. print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
  556. # transmit file
  557. transmitfile($meta->{filehash});
  558. }
  559. next;
  560. }
  561. unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
  562. {
  563. print "E cvs add: nothing known about `$filename'\n";
  564. next;
  565. }
  566. # TODO : check we're not squashing an already existing file
  567. if ( defined ( $state->{entries}{$filename}{revision} ) )
  568. {
  569. print "E cvs add: `$filename' has already been entered\n";
  570. next;
  571. }
  572. my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
  573. print "E cvs add: scheduling file `$filename' for addition\n";
  574. print "Checked-in $dirpart\n";
  575. print "$filename\n";
  576. my $kopts = kopts_from_path($filename,"file",
  577. $state->{entries}{$filename}{modified_filename});
  578. print "/$filepart/0//$kopts/" .
  579. getStickyTagOrDate($stickyInfo) . "\n";
  580. my $requestedKopts = $state->{opt}{k};
  581. if(defined($requestedKopts))
  582. {
  583. $requestedKopts = "-k$requestedKopts";
  584. }
  585. else
  586. {
  587. $requestedKopts = "";
  588. }
  589. if( $kopts ne $requestedKopts )
  590. {
  591. $log->warn("Ignoring requested -k='$requestedKopts'"
  592. . " for '$filename'; detected -k='$kopts' instead");
  593. #TODO: Also have option to send warning to user?
  594. }
  595. $addcount++;
  596. }
  597. if ( $addcount == 1 )
  598. {
  599. print "E cvs add: use `cvs commit' to add this file permanently\n";
  600. }
  601. elsif ( $addcount > 1 )
  602. {
  603. print "E cvs add: use `cvs commit' to add these files permanently\n";
  604. }
  605. print "ok\n";
  606. }
  607. # remove \n
  608. # Response expected: yes. Remove a file. This uses any previous Argument,
  609. # Directory, Entry, or Modified requests, if they have been sent. The last
  610. # Directory sent specifies the working directory at the time of the
  611. # operation. Note that this request does not actually do anything to the
  612. # repository; the only effect of a successful remove request is to supply
  613. # the client with a new entries line containing `-' to indicate a removed
  614. # file. In fact, the client probably could perform this operation without
  615. # contacting the server, although using remove may cause the server to
  616. # perform a few more checks. The client sends a subsequent ci request to
  617. # actually record the removal in the repository.
  618. sub req_remove
  619. {
  620. my ( $cmd, $data ) = @_;
  621. argsplit("remove");
  622. # Grab a handle to the SQLite db and do any necessary updates
  623. my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
  624. $updater->update();
  625. #$log->debug("add state : " . Dumper($state));
  626. my $rmcount = 0;
  627. foreach my $filename ( @{$state->{args}} )
  628. {
  629. $filename = filecleanup($filename);
  630. if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
  631. {
  632. print "E cvs remove: file `$filename' still in working directory\n";
  633. next;
  634. }
  635. # only from entries
  636. my $stickyInfo = resolveStickyInfo($filename);
  637. my $meta = $updater->getmeta($filename,$stickyInfo);
  638. my $wrev = revparse($filename);
  639. unless ( defined ( $wrev ) )
  640. {
  641. print "E cvs remove: nothing known about `$filename'\n";
  642. next;
  643. }
  644. if ( defined($wrev) and ($wrev=~/^-/) )
  645. {
  646. print "E cvs remove: file `$filename' already scheduled for removal\n";
  647. next;
  648. }
  649. unless ( $wrev eq $meta->{revision} )
  650. {
  651. # TODO : not sure if the format of this message is quite correct.
  652. print "E cvs remove: Up to date check failed for `$filename'\n";
  653. next;
  654. }
  655. my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
  656. print "E cvs remove: scheduling `$filename' for removal\n";
  657. print "Checked-in $dirpart\n";
  658. print "$filename\n";
  659. my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
  660. print "/$filepart/-$wrev//$kopts/" . getStickyTagOrDate($stickyInfo) . "\n";
  661. $rmcount++;
  662. }
  663. if ( $rmcount == 1 )
  664. {
  665. print "E cvs remove: use `cvs commit' to remove this file permanently\n";
  666. }
  667. elsif ( $rmcount > 1 )
  668. {
  669. print "E cvs remove: use `cvs commit' to remove these files permanently\n";
  670. }
  671. print "ok\n";
  672. }
  673. # Modified filename \n
  674. # Response expected: no. Additional data: mode, \n, file transmission. Send
  675. # the server a copy of one locally modified file. filename is a file within
  676. # the most recent directory sent with Directory; it must not contain `/'.
  677. # If the user is operating on only some files in a directory, only those
  678. # files need to be included. This can also be sent without Entry, if there
  679. # is no entry for the file.
  680. sub req_Modified
  681. {
  682. my ( $cmd, $data ) = @_;
  683. my $mode = <STDIN>;
  684. defined $mode
  685. or (print "E end of file reading mode for $data\n"), return;
  686. chomp $mode;
  687. my $size = <STDIN>;
  688. defined $size
  689. or (print "E end of file reading size of $data\n"), return;
  690. chomp $size;
  691. # Grab config information
  692. my $blocksize = 8192;
  693. my $bytesleft = $size;
  694. my $tmp;
  695. # Get a filehandle/name to write it to
  696. my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );
  697. # Loop over file data writing out to temporary file.
  698. while ( $bytesleft )
  699. {
  700. $blocksize = $bytesleft if ( $bytesleft < $blocksize );
  701. read STDIN, $tmp, $blocksize;
  702. print $fh $tmp;
  703. $bytesleft -= $blocksize;
  704. }
  705. close $fh
  706. or (print "E failed to write temporary, $filename: $!\n"), return;
  707. # Ensure we have something sensible for the file mode
  708. if ( $mode =~ /u=(\w+)/ )
  709. {
  710. $mode = $1;
  711. } else {
  712. $mode = "rw";
  713. }
  714. # Save the file data in $state
  715. $state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
  716. $state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
  717. $state->{entries}{$state->{directory}.$data}{modified_hash} = safe_pipe_capture('git','hash-object',$filename);
  718. $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
  719. #$log->debug("req_Modified : file=$data mode=$mode size=$size");
  720. }
  721. # Unchanged filename \n
  722. # Response expected: no. Tell the server that filename has not been
  723. # modified in the checked out directory. The filename is a file within the
  724. # most recent directory sent with Directory; it must not contain `/'.
  725. sub req_Unchanged
  726. {
  727. my ( $cmd, $data ) = @_;
  728. $state->{entries}{$state->{directory}.$data}{unchanged} = 1;
  729. #$log->debug("req_Unchanged : $data");
  730. }
  731. # Argument text \n
  732. # Response expected: no. Save argument for use in a subsequent command.
  733. # Arguments accumulate until an argument-using command is given, at which
  734. # point they are forgotten.
  735. # Argumentx text \n
  736. # Response expected: no. Append \n followed by text to the current argument
  737. # being saved.
  738. sub req_Argument
  739. {
  740. my ( $cmd, $data ) = @_;
  741. # Argumentx means: append to last Argument (with a newline in front)
  742. $log->debug("$cmd : $data");
  743. if ( $cmd eq 'Argumentx') {
  744. ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
  745. } else {
  746. push @{$state->{arguments}}, $data;
  747. }
  748. }
  749. # expand-modules \n
  750. # Response expected: yes. Expand the modules which are specified in the
  751. # arguments. Returns the data in Module-expansion responses. Note that the
  752. # server can assume that this is checkout or export, not rtag or rdiff; the
  753. # latter do not access the working directory and thus have no need to
  754. # expand modules on the client side. Expand may not be the best word for
  755. # what this request does. It does not necessarily tell you all the files
  756. # contained in a module, for example. Basically it is a way of telling you
  757. # which working directories the server needs to know about in order to
  758. # handle a checkout of the specified modules. For example, suppose that the
  759. # server has a module defined by
  760. # aliasmodule -a 1dir
  761. # That is, one can check out aliasmodule and it will take 1dir in the
  762. # repository and check it out to 1dir in the working directory. Now suppose
  763. # the client already has this module checked out and is planning on using
  764. # the co request to update it. Without using expand-modules, the client
  765. # would have two bad choices: it could either send information about all
  766. # working directories under the current directory, which could be
  767. # unnecessarily slow, or it could be ignorant of the fact that aliasmodule
  768. # stands for 1dir, and neglect to send information for 1dir, which would
  769. # lead to incorrect operation. With expand-modules, the client would first
  770. # ask for the module to be expanded:
  771. sub req_expandmodules
  772. {
  773. my ( $cmd, $data ) = @_;
  774. argsplit();
  775. $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
  776. unless ( ref $state->{arguments} eq "ARRAY" )
  777. {
  778. print "ok\n";
  779. return;
  780. }
  781. foreach my $module ( @{$state->{arguments}} )
  782. {
  783. $log->debug("SEND : Module-expansion $module");
  784. print "Module-expansion $module\n";
  785. }
  786. print "ok\n";
  787. statecleanup();
  788. }
  789. # co \n
  790. # Response expected: yes. Get files from the repository. This uses any
  791. # previous Argument, Directory, Entry, or Modified requests, if they have
  792. # been sent. Arguments to this command are module names; the client cannot
  793. # know what directories they correspond to except by (1) just sending the
  794. # co request, and then seeing what directory names the server sends back in
  795. # its responses, and (2) the expand-modules request.
  796. sub req_co
  797. {
  798. my ( $cmd, $data ) = @_;
  799. argsplit("co");
  800. # Provide list of modules, if -c was used.
  801. if (exists $state->{opt}{c}) {
  802. my $showref = safe_pipe_capture(qw(git show-ref --heads));
  803. for my $line (split '\n', $showref) {
  804. if ( $line =~ m% refs/heads/(.*)$% ) {
  805. print "M $1\t$1\n";
  806. }
  807. }
  808. print "ok\n";
  809. return 1;
  810. }
  811. my $stickyInfo = { 'tag' => $state->{opt}{r},
  812. 'date' => $state->{opt}{D} };
  813. my $module = $state->{args}[0];
  814. $state->{module} = $module;
  815. my $checkout_path = $module;
  816. # use the user specified directory if we're given it
  817. $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
  818. $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
  819. $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
  820. $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
  821. # Grab a handle to the SQLite db and do any necessary updates
  822. my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
  823. $updater->update();
  824. my $headHash;
  825. if( defined($stickyInfo) && defined($stickyInfo->{tag}) )
  826. {
  827. $headHash = $updater->lookupCommitRef($stickyInfo->{tag});
  828. if( !defined($headHash) )
  829. {
  830. print "error 1 no such tag `$stickyInfo->{tag}'\n";
  831. cleanupWorkTree();
  832. exit;
  833. }
  834. }
  835. $checkout_path =~ s|/$||; # get rid of trailing slashes
  836. my %seendirs = ();
  837. my $lastdir ='';
  838. prepDirForOutput(
  839. ".",
  840. $state->{CVSROOT} . "/$module",
  841. $checkout_path,
  842. \%seendirs,
  843. 'checkout',
  844. $state->{dirArgs} );
  845. foreach my $git ( @{$updater->getAnyHead($headHash)} )
  846. {
  847. # Don't want to check out deleted files
  848. next if ( $git->{filehash} eq "deleted" );
  849. my $fullName = $git->{name};
  850. ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
  851. unless (exists($seendirs{$git->{dir}})) {
  852. prepDirForOutput($git->{dir}, $state->{CVSROOT} . "/$module/",
  853. $checkout_path, \%seendirs, 'checkout',
  854. $state->{dirArgs} );
  855. $lastdir = $git->{dir};
  856. $seendirs{$git->{dir}} = 1;
  857. }
  858. # modification time of this file
  859. print "Mod-time $git->{modified}\n";
  860. # print some information to the client
  861. if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
  862. {
  863. print "M U $checkout_path/$git->{dir}$git->{name}\n";
  864. } else {
  865. print "M U $checkout_path/$git->{name}\n";
  866. }
  867. # instruct client we're sending a file to put in this path
  868. print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
  869. print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
  870. # this is an "entries" line
  871. my $kopts = kopts_from_path($fullName,"sha1",$git->{filehash});
  872. print "/$git->{name}/$git->{revision}//$kopts/" .
  873. getStickyTagOrDate($stickyInfo) . "\n";
  874. # permissions
  875. print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
  876. # transmit file
  877. transmitfile($git->{filehash});
  878. }
  879. print "ok\n";
  880. statecleanup();
  881. }
  882. # used by req_co and req_update to set up directories for files
  883. # recursively handles parents
  884. sub prepDirForOutput
  885. {
  886. my ($dir, $repodir, $remotedir, $seendirs, $request, $dirArgs) = @_;
  887. my $parent = dirname($dir);
  888. $dir =~ s|/+$||;
  889. $repodir =~ s|/+$||;
  890. $remotedir =~ s|/+$||;
  891. $parent =~ s|/+$||;
  892. if ($parent eq '.' || $parent eq './')
  893. {
  894. $parent = '';
  895. }
  896. # recurse to announce unseen parents first
  897. if( length($parent) &&
  898. !exists($seendirs->{$parent}) &&
  899. ( $request eq "checkout" ||
  900. exists($dirArgs->{$parent}) ) )
  901. {
  902. prepDirForOutput($parent, $repodir, $remotedir,
  903. $seendirs, $request, $dirArgs);
  904. }
  905. # Announce that we are going to modify at the parent level
  906. if ($dir eq '.' || $dir eq './')
  907. {
  908. $dir = '';
  909. }
  910. if(exists($seendirs->{$dir}))
  911. {
  912. return;
  913. }
  914. $log->debug("announcedir $dir, $repodir, $remotedir" );
  915. my($thisRemoteDir,$thisRepoDir);
  916. if ($dir ne "")
  917. {
  918. $thisRepoDir="$repodir/$dir";
  919. if($remotedir eq ".")
  920. {
  921. $thisRemoteDir=$dir;
  922. }
  923. else
  924. {
  925. $thisRemoteDir="$remotedir/$dir";
  926. }
  927. }
  928. else
  929. {
  930. $thisRepoDir=$repodir;
  931. $thisRemoteDir=$remotedir;
  932. }
  933. unless ( $state->{globaloptions}{-Q} || $state->{globaloptions}{-q} )
  934. {
  935. print "E cvs $request: Updating $thisRemoteDir\n";
  936. }
  937. my ($opt_r)=$state->{opt}{r};
  938. my $stickyInfo;
  939. if(exists($state->{opt}{A}))
  940. {
  941. # $stickyInfo=undef;
  942. }
  943. elsif( defined($opt_r) && $opt_r ne "" )
  944. # || ( defined($state->{opt}{D}) && $state->{opt}{D} ne "" ) # TODO
  945. {
  946. $stickyInfo={ 'tag' => (defined($opt_r)?$opt_r:undef) };
  947. # TODO: Convert -D value into the form 2011.04.10.04.46.57,
  948. # similar to an entry line's sticky date, without the D prefix.
  949. # It sometimes (always?) arrives as something more like
  950. # '10 Apr 2011 04:46:57 -0000'...
  951. # $stickyInfo={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
  952. }
  953. else
  954. {
  955. $stickyInfo=getDirStickyInfo($state->{prependdir} . $dir);
  956. }
  957. my $stickyResponse;
  958. if(defined($stickyInfo))
  959. {
  960. $stickyResponse = "Set-sticky $thisRemoteDir/\n" .
  961. "$thisRepoDir/\n" .
  962. getStickyTagOrDate($stickyInfo) . "\n";
  963. }
  964. else
  965. {
  966. $stickyResponse = "Clear-sticky $thisRemoteDir/\n" .
  967. "$thisRepoDir/\n";
  968. }
  969. unless ( $state->{globaloptions}{-n} )
  970. {
  971. print $stickyResponse;
  972. print "Clear-static-directory $thisRemoteDir/\n";
  973. print "$thisRepoDir/\n";
  974. print $stickyResponse; # yes, twice
  975. print "Template $thisRemoteDir/\n";
  976. print "$thisRepoDir/\n";
  977. print "0\n";
  978. }
  979. $seendirs->{$dir} = 1;
  980. # FUTURE: This would more accurately emulate CVS by sending
  981. # another copy of sticky after processing the files in that
  982. # directory. Or intermediate: perhaps send all sticky's for
  983. # $seendirs after processing all files.
  984. }
  985. # update \n
  986. # Response expected: yes. Actually do a cvs update command. This uses any
  987. # previous Argument, Directory, Entry, or Modified requests, if they have
  988. # been sent. The last Directory sent specifies the working directory at the
  989. # time of the operation. The -I option is not used--files which the client
  990. # can decide whether to ignore are not mentioned and the client sends the
  991. # Questionable request for others.
  992. sub req_update
  993. {
  994. my ( $cmd, $data ) = @_;
  995. $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
  996. argsplit("update");
  997. #
  998. # It may just be a client exploring the available heads/modules
  999. # in that case, list them as top level directories and leave it
  1000. # at that. Eclipse uses this technique to offer you a list of
  1001. # projects (heads in this case) to checkout.
  1002. #
  1003. if ($state->{module} eq '') {
  1004. my $showref = safe_pipe_capture(qw(git show-ref --heads));
  1005. print "E cvs update: Updating .\n";
  1006. for my $line (split '\n', $showref) {
  1007. if ( $line =~ m% refs/heads/(.*)$% ) {
  1008. print "E cvs update: New directory `$1'\n";
  1009. }
  1010. }
  1011. print "ok\n";
  1012. return 1;
  1013. }
  1014. # Grab a handle to the SQLite db and do any necessary updates
  1015. my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
  1016. $updater->update();
  1017. argsfromdir($updater);
  1018. #$log->debug("update state : " . Dumper($state));
  1019. my($repoDir);
  1020. $repoDir=$state->{CVSROOT} . "/$state->{module}/$state->{prependdir}";
  1021. my %seendirs = ();
  1022. # foreach file specified on the command line ...
  1023. foreach my $argsFilename ( @{$state->{args}} )
  1024. {
  1025. my $filename;
  1026. $filename = filecleanup($argsFilename);
  1027. $log->debug("Processing file $filename");
  1028. # if we have a -C we should pretend we never saw modified stuff
  1029. if ( exists ( $state->{opt}{C} ) )
  1030. {
  1031. delete $state->{entries}{$filename}{modified_hash};
  1032. delete $state->{entries}{$filename}{modified_filename};
  1033. $state->{entries}{$filename}{unchanged} = 1;
  1034. }
  1035. my $stickyInfo = resolveStickyInfo($filename,
  1036. $state->{opt}{r},
  1037. $state->{opt}{D},
  1038. exists($state->{opt}{A}));
  1039. my $meta = $updater->getmeta($filename, $stickyInfo);
  1040. # If -p was given, "print" the contents of the requested revision.
  1041. if ( exists ( $state->{opt}{p} ) ) {
  1042. if ( defined ( $meta->{revision} ) ) {
  1043. $log->info("Printing '$filename' revision " . $meta->{revision});
  1044. transmitfile($meta->{filehash}, { print => 1 });
  1045. }
  1046. next;
  1047. }
  1048. # Directories:
  1049. prepDirForOutput(
  1050. dirname($argsFilename),
  1051. $repoDir,
  1052. ".",
  1053. \%seendirs,
  1054. "update",
  1055. $state->{dirArgs} );
  1056. my $wrev = revparse($filename);
  1057. if ( ! defined $meta )
  1058. {
  1059. $meta = {
  1060. name => $filename,
  1061. revision => '0',
  1062. filehash => 'added'
  1063. };
  1064. if($wrev ne "0")
  1065. {
  1066. $meta->{filehash}='deleted';
  1067. }
  1068. }
  1069. my $oldmeta = $meta;
  1070. # If the working copy is an old revision, lets get that version too for comparison.
  1071. my $oldWrev=$wrev;
  1072. if(defined($oldWrev))
  1073. {
  1074. $oldWrev=~s/^-//;
  1075. if($oldWrev ne $meta->{revision})
  1076. {
  1077. $oldmeta = $updater->getmeta($filename, $oldWrev);
  1078. }
  1079. }
  1080. #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
  1081. # Files are up to date if the working copy and repo copy have the same revision,
  1082. # and the working copy is unmodified _and_ the user hasn't specified -C
  1083. next if ( defined ( $wrev )
  1084. and defined($meta->{revision})
  1085. and $wrev eq $meta->{revision}
  1086. and $state->{entries}{$filename}{unchanged}
  1087. and not exists ( $state->{opt}{C} ) );
  1088. # If the working copy and repo copy have the same revision,
  1089. # but the working copy is modified, tell the client it's modified
  1090. if ( defined ( $wrev )
  1091. and defined($meta->{revision})
  1092. and $wrev eq $meta->{revision}
  1093. and $wrev ne "0"
  1094. and defined($state->{entries}{$filename}{modified_hash})
  1095. and not exists ( $state->{opt}{C} ) )
  1096. {
  1097. $log->info("Tell the client the file is modified");
  1098. print "MT text M \n";
  1099. print "MT fname $filename\n";
  1100. print "MT newline\n";
  1101. next;
  1102. }
  1103. if ( $meta->{filehash} eq "deleted" && $wrev ne "0" )
  1104. {
  1105. # TODO: If it has been modified in the sandbox, error out
  1106. # with the appropriate message, rather than deleting a modified
  1107. # file.
  1108. my ( $filepart, $dirpart ) = filenamesplit($filename,1);
  1109. $log->info("Removing '$filename' from working copy (no longer in the repo)");
  1110. print "E cvs update: `$filename' is no longer in the repository\n";
  1111. # Don't want to actually _DO_ the update if -n specified
  1112. unless ( $state->{globaloptions}{-n} ) {
  1113. print "Removed $dirpart\n";
  1114. print "$filepart\n";
  1115. }
  1116. }
  1117. elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
  1118. or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
  1119. or $meta->{filehash} eq 'added' )
  1120. {
  1121. # normal update, just send the new revision (either U=Update,
  1122. # or A=Add, or R=Remove)
  1123. if ( defined($wrev) && ($wrev=~/^-/) )
  1124. {
  1125. $log->info("Tell the client the file is scheduled for removal");
  1126. print "MT text R \n";
  1127. print "MT fname $filename\n";
  1128. print "MT newline\n";
  1129. next;
  1130. }
  1131. elsif ( (!defined($wrev) || $wrev eq '0') &&
  1132. (!defined($meta->{revision}) || $meta->{revision} eq '0') )
  1133. {
  1134. $log->info("Tell the client the file is scheduled for addition");
  1135. print "MT text A \n";
  1136. print "MT fname $filename\n";
  1137. print "MT newline\n";
  1138. next;
  1139. }
  1140. else {
  1141. $log->info("UpdatingX3 '$filename' to ".$meta->{revision});
  1142. print "MT +updated\n";
  1143. print "MT text U \n";
  1144. print "MT fname $filename\n";
  1145. print "MT newline\n";
  1146. print "MT -updated\n";
  1147. }
  1148. my ( $filepart, $dirpart ) = filenamesplit($filename,1);
  1149. # Don't want to actually _DO_ the update if -n specified
  1150. unless ( $state->{globaloptions}{-n} )
  1151. {
  1152. if ( defined ( $wrev ) )
  1153. {
  1154. # instruct client we're sending a file to put in this path as a replacement
  1155. print "Update-existing $dirpart\n";
  1156. $log->debug("Updating existing file 'Update-existing $dirpart'");
  1157. } else {
  1158. # instruct client we're sending a file to put in this path as a new file
  1159. $log->debug("Creating new file 'Created $dirpart'");
  1160. print "Created $dirpart\n";
  1161. }
  1162. print $state->{CVSROOT} . "/$state->{module}/$filename\n";
  1163. # this is an "entries" line
  1164. my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
  1165. my $entriesLine = "/$filepart/$meta->{revision}//$kopts/";
  1166. $entriesLine .= getStickyTagOrDate($stickyInfo);
  1167. $log->debug($entriesLine);
  1168. print "$entriesLine\n";
  1169. # permissions
  1170. $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
  1171. print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
  1172. # transmit file
  1173. transmitfile($meta->{filehash});
  1174. }
  1175. } else {
  1176. my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
  1177. my $mergeDir = setupTmpDir();
  1178. my $file_local = $filepart . ".mine";
  1179. my $mergedFile = "$mergeDir/$file_local";
  1180. system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
  1181. my $file_old = $filepart . "." . $oldmeta->{revision};
  1182. transmitfile($oldmeta->{filehash}, { targetfile => $file_old });
  1183. my $file_new = $filepart . "." . $meta->{revision};
  1184. transmitfile($meta->{filehash}, { targetfile => $file_new });
  1185. # we need to merge with the local changes ( M=successful merge, C=conflict merge )
  1186. $log->info("Merging $file_local, $file_old, $file_new");
  1187. print "M Merging differences between $oldmeta->{revision} and $meta->{revision} into $filename\n";
  1188. $log->debug("Temporary directory for merge is $mergeDir");
  1189. my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
  1190. $return >>= 8;
  1191. cleanupTmpDir();
  1192. if ( $return == 0 )
  1193. {
  1194. $log->info("Merged successfully");
  1195. print "M M $filename\n";
  1196. $log->debug("Merged $dirpart");
  1197. # Don't want to actually _DO_ the update if -n specified
  1198. unless ( $state->{globaloptions}{-n} )
  1199. {
  1200. print "Merged $dirpart\n";
  1201. $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
  1202. print $state->{CVSROOT} . "/$state->{module}/$filename\n";
  1203. my $kopts = kopts_from_path("$dirpart/$filepart",
  1204. "file",$mergedFile);
  1205. $log->debug("/$filepart/$meta->{revision}//$kopts/");
  1206. my $entriesLine="/$filepart/$meta->{revision}//$kopts/";
  1207. $entriesLine .= getStickyTagOrDate($stickyInfo);
  1208. print "$entriesLine\n";
  1209. }
  1210. }
  1211. elsif ( $return == 1 )
  1212. {
  1213. $log->info("Merged with conflicts");
  1214. print "E cvs update: conflicts found in $filename\n";
  1215. print "M C $filename\n";
  1216. # Don't want to actually _DO_ the update if -n specified
  1217. unless ( $state->{globaloptions}{-n} )
  1218. {
  1219. print "Merged $dirpart\n";
  1220. print $state->{CVSROOT} . "/$state->{module}/$filename\n";
  1221. my $kopts = kopts_from_path("$dirpart/$filepart",
  1222. "file",$mergedFile);
  1223. my $entriesLine = "/$filepart/$meta->{revision}/+/$kopts/";
  1224. $entriesLine .= getStickyTagOrDate($stickyInfo);
  1225. print "$entriesLine\n";
  1226. }
  1227. }
  1228. else
  1229. {
  1230. $log->warn("Merge failed");
  1231. next;
  1232. }
  1233. # Don't want to actually _DO_ the update if -n specified
  1234. unless ( $state->{globaloptions}{-n} )
  1235. {
  1236. # permissions
  1237. $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
  1238. print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
  1239. # transmit file, format is single integer on a line by itself (file
  1240. # size) followed by the file contents
  1241. # TODO : we should copy files in blocks
  1242. my $data = safe_pipe_capture('cat', $mergedFile);
  1243. $log->debug("File size : " . length($data));
  1244. print length($data) . "\n";
  1245. print $data;
  1246. }
  1247. }
  1248. }
  1249. # prepDirForOutput() any other existing directories unless they already
  1250. # have the right sticky tag:
  1251. unless ( $state->{globaloptions}{n} )
  1252. {
  1253. my $dir;
  1254. foreach $dir (keys(%{$state->{dirMap}}))
  1255. {
  1256. if( ! $seendirs{$dir} &&
  1257. exists($state->{dirArgs}{$dir}) )
  1258. {
  1259. my($oldTag);
  1260. $oldTag=$state->{dirMap}{$dir}{tagspec};
  1261. unless( ( exists($state->{opt}{A}) &&
  1262. defined($oldTag) ) ||
  1263. ( defined($state->{opt}{r}) &&
  1264. ( !defined($oldTag) ||
  1265. $state->{opt}{r} ne $oldTag ) ) )
  1266. # TODO?: OR sticky dir is different...
  1267. {
  1268. next;
  1269. }
  1270. prepDirForOutput(
  1271. $dir,
  1272. $repoDir,
  1273. ".",
  1274. \%seendirs,
  1275. 'update',
  1276. $state->{dirArgs} );
  1277. }
  1278. # TODO?: Consider sending a final duplicate Sticky response
  1279. # to more closely mimic real CVS.
  1280. }
  1281. }
  1282. print "ok\n";
  1283. }
  1284. sub req_ci
  1285. {
  1286. my ( $cmd, $data ) = @_;
  1287. argsplit("ci");
  1288. #$log->debug("State : " . Dumper($state));
  1289. $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
  1290. if ( $state->{method} eq 'pserver' and $state->{user} eq 'anonymous' )
  1291. {
  1292. print "error 1 anonymous user cannot commit via pserver\n";
  1293. cleanupWorkTree();
  1294. exit;
  1295. }
  1296. if ( -e $state->{CVSROOT} . "/index" )
  1297. {
  1298. $log->warn("file 'index' already exists in the git repository");
  1299. print "error 1 Index already exists in git repo\n";
  1300. cleanupWorkTree();
  1301. exit;
  1302. }
  1303. # Grab a handle to the SQLite db and do any necessary updates
  1304. my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
  1305. $updater->update();
  1306. my @committedfiles = ();
  1307. my %oldmeta;
  1308. my $stickyInfo;
  1309. my $branchRef;
  1310. my $parenthash;
  1311. # foreach file specified on the command line ...
  1312. foreach my $filename ( @{$state->{args}} )
  1313. {
  1314. my $committedfile = $filename;
  1315. $filename = filecleanup($filename);
  1316. next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
  1317. #####
  1318. # Figure out which branch and parenthash we are committing
  1319. # to, and setup worktree:
  1320. # should always come from entries:
  1321. my $fileStickyInfo = resolveStickyInfo($filename);
  1322. if( !defined($branchRef) )
  1323. {
  1324. $stickyInfo = $fileStickyInfo;
  1325. if( defined($stickyInfo) &&
  1326. ( defined($stickyInfo->{date}) ||
  1327. !defined($stickyInfo->{tag}) ) )
  1328. {
  1329. print "error 1 cannot commit with sticky date for file `$filename'\n";
  1330. cleanupWorkTree();
  1331. exit;
  1332. }
  1333. $branchRef = "refs/heads/$state->{module}";
  1334. if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
  1335. {
  1336. $branchRef = "refs/heads/$stickyInfo->{tag}";
  1337. }
  1338. $parenthash = safe_pipe_capture('git', 'show-ref', '-s', $branchRef);
  1339. chomp $parenthash;
  1340. if ($parenthash !~ /^[0-9a-f]{40}$/)
  1341. {
  1342. if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
  1343. {
  1344. print "error 1 sticky tag `$stickyInfo->{tag}' for file `$filename' is not a branch\n";
  1345. }
  1346. else
  1347. {
  1348. print "error 1 pserver cannot find the current HEAD of module";
  1349. }
  1350. cleanupWorkTree();
  1351. exit;
  1352. }
  1353. setupWorkTree($parenthash);
  1354. $log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");
  1355. $log->info("Created index '$work->{index}' for head $state->{module} - exit status $?");
  1356. }
  1357. elsif( !refHashEqual($stickyInfo,$fileStickyInfo) )
  1358. {
  1359. #TODO: We could split the cvs commit into multiple
  1360. # git commits by distinct stickyTag values, but that
  1361. # is lowish priority.
  1362. print "error 1 Committing different files to different"
  1363. . " branches is not currently supported\n";
  1364. cleanupWorkTree();
  1365. exit;
  1366. }
  1367. #####
  1368. # Process this file:
  1369. my $meta = $updater->getmeta($filename,$stickyInfo);
  1370. $oldmeta{$filename} = $meta;
  1371. my $wrev = revparse($filename);
  1372. my ( $filepart, $dirpart ) = filenamesplit($filename);
  1373. # do a checkout of the file if it is part of this tree
  1374. if ($wrev) {
  1375. system('git', 'checkout-index', '-f', '-u', $filename);
  1376. unless ($? == 0) {
  1377. die "Error running git-checkout-index -f -u $filename : $!";
  1378. }
  1379. }
  1380. my $addflag = 0;
  1381. my $rmflag = 0;
  1382. $rmflag = 1 if ( defined($wrev) and ($wrev=~/^-/) );
  1383. $addflag = 1 unless ( -e $filename );
  1384. # Do up to date checking
  1385. unless ( $addflag or $wrev eq $meta->{revision} or
  1386. ( $rmflag and $wrev eq "-$meta->{revision}" ) )
  1387. {
  1388. # fail everything if an up to date check fails
  1389. print "error 1 Up to date check failed for $filename\n";
  1390. cleanupWorkTree();
  1391. exit;
  1392. }
  1393. push @committedfiles, $committedfile;
  1394. $log->info("Committing $filename");
  1395. system("mkdir","-p",$dirpart) unless ( -d $dirpart );
  1396. unless ( $rmflag )
  1397. {
  1398. $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
  1399. rename $state->{entries}{$filename}{modified_filename},$filename;
  1400. # Calculate modes to remove
  1401. my $invmode = "";
  1402. foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
  1403. $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
  1404. system("chmod","u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
  1405. }
  1406. if ( $rmflag )
  1407. {
  1408. $log->info("Removing file '$filename'");
  1409. unlink($filename);
  1410. system("git", "update-index", "--remove", $filename);
  1411. }
  1412. elsif ( $addflag )
  1413. {
  1414. $log->info("Adding file '$filename'");
  1415. system("git", "update-index", "--add", $filename);
  1416. } else {
  1417. $log->info("UpdatingX2 file '$filename'");
  1418. system("git", "update-index", $filename);
  1419. }
  1420. }
  1421. unless ( scalar(@committedfiles) > 0 )
  1422. {
  1423. print "E No files to commit\n";
  1424. print "ok\n";
  1425. cleanupWorkTree();
  1426. return;
  1427. }
  1428. my $treehash = safe_pipe_capture(qw(git write-tree));
  1429. chomp $treehash;
  1430. $log->debug("Treehash : $treehash, Parenthash : $parenthash");
  1431. # write our commit message out if we have one ...
  1432. my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
  1433. print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
  1434. if ( defined ( $cfg->{gitcvs}{commitmsgannotation} ) ) {
  1435. if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/ ) {
  1436. print $msg_fh "\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"
  1437. }
  1438. } else {
  1439. print $msg_fh "\n\nvia git-CVS emulator\n";
  1440. }
  1441. close $msg_fh;
  1442. my $commithash = safe_pipe_capture('git', 'commit-tree', $treehash, '-p', $parenthash, '-F', $msg_filename);
  1443. chomp($commithash);
  1444. $log->info("Commit hash : $commithash");
  1445. unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
  1446. {
  1447. $log->warn("Commit failed (Invalid commit hash)");
  1448. print "error 1 Commit failed (unknown reason)\n";
  1449. cleanupWorkTree();
  1450. exit;
  1451. }
  1452. ### Emulate git-receive-pack by running hooks/update
  1453. my @hook = ( $ENV{GIT_DIR}.'hooks/update', $branchRef,
  1454. $parenthash, $commithash );
  1455. if( -x $hook[0] ) {
  1456. unless( system( @hook ) == 0 )
  1457. {
  1458. $log->warn("Commit failed (update hook declined to update ref)");
  1459. print "error 1 Commit failed (update hook declined)\n";
  1460. cleanupWorkTree();
  1461. exit;
  1462. }
  1463. }
  1464. ### Update the ref
  1465. if (system(qw(git update-ref -m), "cvsserver ci",
  1466. $branchRef, $commithash, $parenthash)) {
  1467. $log->warn("update-ref for $state->{module} failed.");
  1468. print "error 1 Cannot commit -- update first\n";
  1469. cleanupWorkTree();
  1470. exit;
  1471. }
  1472. ### Emulate git-receive-pack by running hooks/post-receive
  1473. my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
  1474. if( -x $hook ) {
  1475. open(my $pipe, "| $hook") || die "can't fork $!";
  1476. local $SIG{PIPE} = sub { die 'pipe broke' };
  1477. print $pipe "$parenthash $commithash $branchRef\n";
  1478. close $pipe || die "bad pipe: $! $?";
  1479. }
  1480. $updater->update();
  1481. ### Then hooks/post-update
  1482. $hook = $ENV{GIT_DIR}.'hooks/post-update';
  1483. if (-x $hook) {
  1484. system($hook, $branchRef);
  1485. }
  1486. # foreach file specified on the command line ...
  1487. foreach my $filename ( @committedfiles )
  1488. {
  1489. $filename = filecleanup($filename);
  1490. my $meta = $updater->getmeta($filename,$stickyInfo);
  1491. unless (defined $meta->{revision}) {
  1492. $meta->{revision} = "1.1";
  1493. }
  1494. my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
  1495. $log->debug("Checked-in $dirpart : $filename");
  1496. print "M $state->{CVSROOT}/$state->{module}/$filename,v <-- $dirpart$filepart\n";
  1497. if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
  1498. {
  1499. print "M new revision: delete; previous revision: $oldmeta{$filename}{revision}\n";
  1500. print "Remove-entry $dirpart\n";
  1501. print "$filename\n";
  1502. } else {
  1503. if ($meta->{revision} eq "1.1") {
  1504. print "M initial revision: 1.1\n";
  1505. } else {
  1506. print "M new revision: $meta->{revision}; previous revision: $oldmeta{$filename}{revision}\n";
  1507. }
  1508. print "Checked-in $dirpart\n";
  1509. print "$filename\n";
  1510. my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
  1511. print "/$filepart/$meta->{revision}//$kopts/" .
  1512. getStickyTagOrDate($stickyInfo) . "\n";
  1513. }
  1514. }
  1515. cleanupWorkTree();
  1516. print "ok\n";
  1517. }
  1518. sub req_status
  1519. {
  1520. my ( $cmd, $data ) = @_;
  1521. argsplit("status");
  1522. $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
  1523. #$log->debug("status state : " . Dumper($state));
  1524. # Grab a handle to the SQLite db and do any necessary updates
  1525. my $updater;
  1526. $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
  1527. $updater->update();
  1528. # if no files were specified, we need to work out what files we should
  1529. # be providing status on ...
  1530. argsfromdir($updater);
  1531. # foreach file specified on the command line ...
  1532. foreach my $filename ( @{$state->{args}} )
  1533. {
  1534. $filename = filecleanup($filename);
  1535. if ( exists($state->{opt}{l}) &&
  1536. index($filename, '/', length($state->{prependdir})) >= 0 )
  1537. {
  1538. next;
  1539. }
  1540. my $wrev = revparse($filename);
  1541. my $stickyInfo = resolveStickyInfo($filename);
  1542. my $meta = $updater->getmeta($filename,$stickyInfo);
  1543. my $oldmeta = $meta;
  1544. # If the working copy is an old revision, lets get that
  1545. # version too for comparison.
  1546. if ( defined($wrev) and $wrev ne $meta->{revision} )
  1547. {
  1548. my($rmRev)=$wrev;
  1549. $rmRev=~s/^-//;
  1550. $oldmeta = $updater->getmeta($filename, $rmRev);
  1551. }
  1552. # TODO : All possible statuses aren't yet implemented
  1553. my $status;
  1554. # Files are up to date if the working copy and repo copy have
  1555. # the same revision, and the working copy is unmodified
  1556. if ( defined ( $wrev ) and defined($meta->{revision}) and
  1557. $wrev eq $meta->{revision} and
  1558. ( ( $state->{entries}{$filename}{unchanged} and
  1559. ( not defined ( $state->{entries}{$filename}{conflict} ) or
  1560. $state->{entries}{$filename}{conflict} !~ /^\+=/ ) ) or
  1561. ( defined($state->{entries}{$filename}{modified_hash}) and
  1562. $state->{entries}{$filename}{modified_hash} eq
  1563. $meta->{filehash} ) ) )
  1564. {
  1565. $status = "Up-to-date"
  1566. }
  1567. # Need checkout if the working copy has a different (usually
  1568. # older) revision than the repo copy, and the working copy is
  1569. # unmodified
  1570. if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
  1571. $meta->{revision} ne $wrev and
  1572. ( $state->{entries}{$filename}{unchanged} or
  1573. ( defined($state->{entries}{$filename}{modified_hash}) and
  1574. $state->{entries}{$filename}{modified_hash} eq
  1575. $oldmeta->{filehash} ) ) )
  1576. {
  1577. $status ||= "Needs Checkout";
  1578. }
  1579. # Need checkout if it exists in the repo but doesn't have a working
  1580. # copy
  1581. if ( not defined ( $wrev ) and defined ( $meta->{revision} ) )
  1582. {
  1583. $status ||= "Needs Checkout";
  1584. }
  1585. # Locally modified if working copy and repo copy have the
  1586. # same revision but there are local changes
  1587. if ( defined ( $wrev ) and defined($meta->{revision}) and
  1588. $wrev eq $meta->{revision} and
  1589. $wrev ne "0" and
  1590. $state->{entries}{$filename}{modified_filename} )
  1591. {
  1592. $status ||= "Locally Modified";
  1593. }
  1594. # Needs Merge if working copy revision is different
  1595. # (usually older) than repo copy and there are local changes
  1596. if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
  1597. $meta->{revision} ne $wrev and
  1598. $state->{entries}{$filename}{modified_filename} )
  1599. {
  1600. $status ||= "Needs Merge";
  1601. }
  1602. if ( defined ( $state->{entries}{$filename}{revision} ) and
  1603. ( !defined($meta->{revision}) ||
  1604. $meta->{revision} eq "0" ) )
  1605. {
  1606. $status ||= "Locally Added";
  1607. }
  1608. if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
  1609. $wrev eq "-$meta->{revision}" )
  1610. {
  1611. $status ||= "Locally Removed";
  1612. }
  1613. if ( defined ( $state->{entries}{$filename}{conflict} ) and
  1614. $state->{entries}{$filename}{conflict} =~ /^\+=/ )
  1615. {
  1616. $status ||= "Unresolved Conflict";
  1617. }
  1618. if ( 0 )
  1619. {
  1620. $status ||= "File had conflicts on merge";
  1621. }
  1622. $status ||= "Unknown";
  1623. my ($filepart) = filenamesplit($filename);
  1624. print "M =======" . ( "=" x 60 ) . "\n";
  1625. print "M File: $filepart\tStatus: $status\n";
  1626. if ( defined($state->{entries}{$filename}{revision}) )
  1627. {
  1628. print "M Working revision:\t" .
  1629. $state->{entries}{$filename}{revision} . "\n";
  1630. } else {
  1631. print "M Working revision:\tNo entry for $filename\n";
  1632. }
  1633. if ( defined($meta->{revision}) )
  1634. {
  1635. print "M Repository revision:\t" .
  1636. $meta->{revision} .
  1637. "\t$state->{CVSROOT}/$state->{module}/$filename,v\n";
  1638. my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
  1639. my($tag)=($tagOrDate=~m/^T(.+)$/);
  1640. if( !defined($tag) )
  1641. {
  1642. $tag="(none)";
  1643. }
  1644. print "M Sticky Tag:\t\t$tag\n";
  1645. my($date)=($tagOrDate=~m/^D(.+)$/);
  1646. if( !defined($date) )
  1647. {
  1648. $date="(none)";
  1649. }
  1650. print "M Sticky Date:\t\t$date\n";
  1651. my($options)=$state->{entries}{$filename}{options};
  1652. if( $options eq "" )
  1653. {
  1654. $options="(none)";
  1655. }
  1656. print "M Sticky Options:\t\t$options\n";
  1657. } else {
  1658. print "M Repository revision:\tNo revision control file\n";
  1659. }
  1660. print "M\n";
  1661. }
  1662. print "ok\n";
  1663. }
  1664. sub req_diff
  1665. {
  1666. my ( $cmd, $data ) = @_;
  1667. argsplit("diff");
  1668. $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
  1669. #$log->debug("status state : " . Dumper($state));
  1670. my ($revision1, $revision2);
  1671. if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
  1672. {
  1673. $revision1 = $state->{opt}{r}[0];
  1674. $revision2 = $state->{opt}{r}[1];
  1675. } else {
  1676. $revision1 = $state->{opt}{r};
  1677. }
  1678. $log->debug("Diffing revisions " .
  1679. ( defined($revision1) ? $revision1 : "[NULL]" ) .
  1680. " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
  1681. # Grab a handle to the SQLite db and do any necessary updates
  1682. my $updater;
  1683. $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
  1684. $updater->update();
  1685. # if no files were specified, we need to work out what files we should
  1686. # be providing status on ...
  1687. argsfromdir($updater);
  1688. my($foundDiff);
  1689. # foreach file specified on the command line ...
  1690. foreach my $argFilename ( @{$state->{args}} )
  1691. {
  1692. my($filename) = filecleanup($argFilename);
  1693. my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
  1694. my $wrev = revparse($filename);
  1695. # Priority for revision1:
  1696. # 1. First -r (missing file: check -N)
  1697. # 2. wrev from client's Entry line
  1698. # - missing line/file: check -N
  1699. # - "0": added file not committed (empty contents for rev1)
  1700. # - Prefixed with dash (to be removed): check -N
  1701. if ( defined ( $revision1 ) )
  1702. {
  1703. $meta1 = $updater->getmeta($filename, $revision1);
  1704. }
  1705. elsif( defined($wrev) && $wrev ne "0" )
  1706. {
  1707. my($rmRev)=$wrev;
  1708. $rmRev=~s/^-//;
  1709. $meta1 = $updater->getmeta($filename, $rmRev);
  1710. }
  1711. if ( !defined($meta1) ||
  1712. $meta1->{filehash} eq "deleted" )
  1713. {
  1714. if( !exists($state->{opt}{N}) )
  1715. {
  1716. if(!defined($revision1))
  1717. {
  1718. print "E File $filename at revision $revision1 doesn't exist\n";
  1719. }
  1720. next;
  1721. }
  1722. elsif( !defined($meta1) )
  1723. {
  1724. $meta1 = {
  1725. name => $filename,
  1726. revision => '0',
  1727. filehash => 'deleted'
  1728. };
  1729. }
  1730. }
  1731. # Priority for revision2:
  1732. # 1. Second -r (missing file: check -N)
  1733. # 2. Modified file contents from client
  1734. # 3. wrev from client's Entry line
  1735. # - missing line/file: check -N
  1736. # - Prefixed with dash (to be removed): check -N
  1737. # if we have a second -r switch, use it too
  1738. if ( defined ( $revision2 ) )
  1739. {
  1740. $meta2 = $updater->getmeta($filename, $revision2);
  1741. }
  1742. elsif(defined($state->{entries}{$filename}{modified_filename}))
  1743. {
  1744. $file2 = $state->{entries}{$filename}{modified_filename};
  1745. $meta2 = {
  1746. name => $filename,
  1747. revision => '0',
  1748. filehash => 'modified'
  1749. };
  1750. }
  1751. elsif( defined($wrev) && ($wrev!~/^-/) )
  1752. {
  1753. if(!defined($revision1)) # no revision and no modifications:
  1754. {
  1755. next;
  1756. }
  1757. $meta2 = $updater->getmeta($filename, $wrev);
  1758. }
  1759. if(!defined($file2))
  1760. {
  1761. if ( !defined($meta2) ||
  1762. $meta2->{filehash} eq "deleted" )
  1763. {
  1764. if( !exists($state->{opt}{N}) )
  1765. {
  1766. if(!defined($revision2))
  1767. {
  1768. print "E File $filename at revision $revision2 doesn't exist\n";
  1769. }
  1770. next;
  1771. }
  1772. elsif( !defined($meta2) )
  1773. {
  1774. $meta2 = {
  1775. name => $filename,
  1776. revision => '0',
  1777. filehash => 'deleted'
  1778. };
  1779. }
  1780. }
  1781. }
  1782. if( $meta1->{filehash} eq $meta2->{filehash} )
  1783. {
  1784. $log->info("unchanged $filename");
  1785. next;
  1786. }
  1787. # Retrieve revision contents:
  1788. ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
  1789. transmitfile($meta1->{filehash}, { targetfile => $file1 });
  1790. if(!defined($file2))
  1791. {
  1792. ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
  1793. transmitfile($meta2->{filehash}, { targetfile => $file2 });
  1794. }
  1795. # Generate the actual diff:
  1796. print "M Index: $argFilename\n";
  1797. print "M =======" . ( "=" x 60 ) . "\n";
  1798. print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
  1799. if ( defined ( $meta1 ) && $meta1->{revision} ne "0" )
  1800. {
  1801. print "M retrieving revision $meta1->{revision}\n"
  1802. }
  1803. if ( defined ( $meta2 ) && $meta2->{revision} ne "0" )
  1804. {
  1805. print "M retrieving revision $meta2->{revision}\n"
  1806. }
  1807. print "M diff ";
  1808. foreach my $opt ( sort keys %{$state->{opt}} )
  1809. {
  1810. if ( ref $state->{opt}{$opt} eq "ARRAY" )
  1811. {
  1812. foreach my $value ( @{$state->{opt}{$opt}} )
  1813. {
  1814. print "-$opt $value ";
  1815. }
  1816. } else {
  1817. print "-$opt ";
  1818. if ( defined ( $state->{opt}{$opt} ) )
  1819. {
  1820. print "$state->{opt}{$opt} "
  1821. }
  1822. }
  1823. }
  1824. print "$argFilename\n";
  1825. $log->info("Diffing $filename -r $meta1->{revision} -r " .
  1826. ( $meta2->{revision} or "workingcopy" ));
  1827. # TODO: Use --label instead of -L because -L is no longer
  1828. # documented and may go away someday. Not sure if there there are
  1829. # versions that only support -L, which would make this change risky?
  1830. # http://osdir.com/ml/bug-gnu-utils-gnu/2010-12/msg00060.html
  1831. # ("man diff" should actually document the best migration strategy,
  1832. # [current behavior, future changes, old compatibility issues
  1833. # or lack thereof, etc], not just stop mentioning the option...)
  1834. # TODO: Real CVS seems to include a date in the label, before
  1835. # the revision part, without the keyword "revision". The following
  1836. # has minimal changes compared to original versions of
  1837. # git-cvsserver.perl. (Mostly tab vs space after filename.)
  1838. my (@diffCmd) = ( 'diff' );
  1839. if ( exists($state->{opt}{N}) )
  1840. {
  1841. push @diffCmd,"-N";
  1842. }
  1843. if ( exists $state->{opt}{u} )
  1844. {
  1845. push @diffCmd,("-u","-L");
  1846. if( $meta1->{filehash} eq "deleted" )
  1847. {
  1848. push @diffCmd,"/dev/null";
  1849. } else {
  1850. push @diffCmd,("$argFilename\trevision $meta1->{revision}");
  1851. }
  1852. if( defined($meta2->{filehash}) )
  1853. {
  1854. if( $meta2->{filehash} eq "deleted" )
  1855. {
  1856. push @diffCmd,("-L","/dev/null");
  1857. } else {
  1858. push @diffCmd,("-L",
  1859. "$argFilename\trevision $meta2->{revision}");
  1860. }
  1861. } else {
  1862. push @diffCmd,("-L","$argFilename\tworking copy");
  1863. }
  1864. }
  1865. push @diffCmd,($file1,$file2);
  1866. if(!open(DIFF,"-|",@diffCmd))
  1867. {
  1868. $log->warn("Unable to run diff: $!");
  1869. }
  1870. my($diffLine);
  1871. while(defined($diffLine=<DIFF>))
  1872. {
  1873. print "M $diffLine";
  1874. $foundDiff=1;
  1875. }
  1876. close(DIFF);
  1877. }
  1878. if($foundDiff)
  1879. {
  1880. print "error \n";
  1881. }
  1882. else
  1883. {
  1884. print "ok\n";
  1885. }
  1886. }
  1887. sub req_log
  1888. {
  1889. my ( $cmd, $data ) = @_;
  1890. argsplit("log");
  1891. $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
  1892. #$log->debug("log state : " . Dumper($state));
  1893. my ( $revFilter );
  1894. if ( defined ( $state->{opt}{r} ) )
  1895. {
  1896. $revFilter = $state->{opt}{r};
  1897. }
  1898. # Grab a handle to the SQLite db and do any necessary updates
  1899. my $updater;
  1900. $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
  1901. $updater->update();
  1902. # if no files were specified, we need to work out what files we
  1903. # should be providing status on ...
  1904. argsfromdir($updater);
  1905. # foreach file specified on the command line ...
  1906. foreach my $filename ( @{$state->{args}} )
  1907. {
  1908. $filename = filecleanup($filename);
  1909. my $headmeta = $updater->getmeta($filename);
  1910. my ($revisions,$totalrevisions) = $updater->getlog($filename,
  1911. $revFilter);
  1912. next unless ( scalar(@$revisions) );
  1913. print "M \n";
  1914. print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
  1915. print "M Working file: $filename\n";
  1916. print "M head: $headmeta->{revision}\n";
  1917. print "M branch:\n";
  1918. print "M locks: strict\n";
  1919. print "M access list:\n";
  1920. print "M symbolic names:\n";
  1921. print "M keyword substitution: kv\n";
  1922. print "M total revisions: $totalrevisions;\tselected revisions: " .
  1923. scalar(@$revisions) . "\n";
  1924. print "M description:\n";
  1925. foreach my $revision ( @$revisions )
  1926. {
  1927. print "M ----------------------------\n";
  1928. print "M revision $revision->{revision}\n";
  1929. # reformat the date for log output
  1930. if ( $revision->{modified} =~ /(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/ and
  1931. defined($DATE_LIST->{$2}) )
  1932. {
  1933. $revision->{modified} = sprintf('%04d/%02d/%02d %s',
  1934. $3, $DATE_LIST->{$2}, $1, $4 );
  1935. }
  1936. $revision->{author} = cvs_author($revision->{author});
  1937. print "M date: $revision->{modified};" .
  1938. " author: $revision->{author}; state: " .
  1939. ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) .
  1940. "; lines: +2 -3\n";
  1941. my $commitmessage;
  1942. $commitmessage = $updater->commitmessage($revision->{commithash});
  1943. $commitmessage =~ s/^/M /mg;
  1944. print $commitmessage . "\n";
  1945. }
  1946. print "M =======" . ( "=" x 70 ) . "\n";
  1947. }
  1948. print "ok\n";
  1949. }
  1950. sub req_annotate
  1951. {
  1952. my ( $cmd, $data ) = @_;
  1953. argsplit("annotate");
  1954. $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
  1955. #$log->debug("status state : " . Dumper($state));
  1956. # Grab a handle to the SQLite db and do any necessary updates
  1957. my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
  1958. $updater->update();
  1959. # if no files were specified, we need to work out what files we should be providing annotate on ...
  1960. argsfromdir($updater);
  1961. # we'll need a temporary checkout dir
  1962. setupWorkTree();
  1963. $log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");
  1964. # foreach file specified on the command line ...
  1965. foreach my $filename ( @{$state->{args}} )
  1966. {
  1967. $filename = filecleanup($filename);
  1968. my $meta = $updater->getmeta($filename);
  1969. next unless ( $meta->{revision} );
  1970. # get all the commits that this file was in
  1971. # in dense format -- aka skip dead revisions
  1972. my $revisions = $updater->gethistorydense($filename);
  1973. my $lastseenin = $revisions->[0][2];
  1974. # populate the temporary index based on the latest commit were we saw
  1975. # the file -- but do it cheaply without checking out any files
  1976. # TODO: if we got a revision from the client, use that instead
  1977. # to look up the commithash in sqlite (still good to default to
  1978. # the current head as we do now)
  1979. system("git", "read-tree", $lastseenin);
  1980. unless ($? == 0)
  1981. {
  1982. print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
  1983. return;
  1984. }
  1985. $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
  1986. # do a checkout of the file
  1987. system('git', 'checkout-index', '-f', '-u', $filename);
  1988. unless ($? == 0) {
  1989. print "E error running git-checkout-index -f -u $filename : $!\n";
  1990. return;
  1991. }
  1992. $log->info("Annotate $filename");
  1993. # Prepare a file with the commits from the linearized
  1994. # history that annotate should know about. This prevents
  1995. # git-jsannotate telling us about commits we are hiding
  1996. # from the client.
  1997. my $a_hints = "$work->{workDir}/.annotate_hints";
  1998. if (!open(ANNOTATEHINTS, '>', $a_hints)) {
  1999. print "E failed to open '$a_hints' for writing: $!\n";
  2000. return;
  2001. }
  2002. for (my $i=0; $i < @$revisions; $i++)
  2003. {
  2004. print ANNOTATEHINTS $revisions->[$i][2];
  2005. if ($i+1 < @$revisions) { # have we got a parent?
  2006. print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
  2007. }
  2008. print ANNOTATEHINTS "\n";
  2009. }
  2010. print ANNOTATEHINTS "\n";
  2011. close ANNOTATEHINTS
  2012. or (print "E failed to write $a_hints: $!\n"), return;
  2013. my @cmd = (qw(git annotate -l -S), $a_hints, $filename);
  2014. if (!open(ANNOTATE, "-|", @cmd)) {
  2015. print "E error invoking ". join(' ',@cmd) .": $!\n";
  2016. return;
  2017. }
  2018. my $metadata = {};
  2019. print "E Annotations for $filename\n";
  2020. print "E ***************\n";
  2021. while ( <ANNOTATE> )
  2022. {
  2023. if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
  2024. {
  2025. my $commithash = $1;
  2026. my $data = $2;
  2027. unless ( defined ( $metadata->{$commithash} ) )
  2028. {
  2029. $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
  2030. $metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});
  2031. $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
  2032. }
  2033. printf("M %-7s (%-8s %10s): %s\n",
  2034. $metadata->{$commithash}{revision},
  2035. $metadata->{$commithash}{author},
  2036. $metadata->{$commithash}{modified},
  2037. $data
  2038. );
  2039. } else {
  2040. $log->warn("Error in annotate output! LINE: $_");
  2041. print "E Annotate error \n";
  2042. next;
  2043. }
  2044. }
  2045. close ANNOTATE;
  2046. }
  2047. # done; get out of the tempdir
  2048. cleanupWorkTree();
  2049. print "ok\n";
  2050. }
  2051. # This method takes the state->{arguments} array and produces two new arrays.
  2052. # The first is $state->{args} which is everything before the '--' argument, and
  2053. # the second is $state->{files} which is everything after it.
  2054. sub argsplit
  2055. {
  2056. $state->{args} = [];
  2057. $state->{files} = [];
  2058. $state->{opt} = {};
  2059. return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
  2060. my $type = shift;
  2061. if ( defined($type) )
  2062. {
  2063. my $opt = {};
  2064. $opt = { A => 0, N => 0, P => 0, R => 0, c => 0, f => 0, l => 0, n => 0, p => 0, s => 0, r => 1, D => 1, d => 1, k => 1, j => 1, } if ( $type eq "co" );
  2065. $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
  2066. $opt = { A => 0, P => 0, C => 0, d => 0, f => 0, l => 0, R => 0, p => 0, k => 1, r => 1, D => 1, j => 1, I => 1, W => 1 } if ( $type eq "update" );
  2067. $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2, N => 0 } if ( $type eq "diff" );
  2068. $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
  2069. $opt = { k => 1, m => 1 } if ( $type eq "add" );
  2070. $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
  2071. $opt = { l => 0, b => 0, h => 0, R => 0, t => 0, N => 0, S => 0, r => 1, d => 1, s => 1, w => 1 } if ( $type eq "log" );
  2072. while ( scalar ( @{$state->{arguments}} ) > 0 )
  2073. {
  2074. my $arg = shift @{$state->{arguments}};
  2075. next if ( $arg eq "--" );
  2076. next unless ( $arg =~ /\S/ );
  2077. # if the argument looks like a switch
  2078. if ( $arg =~ /^-(\w)(.*)/ )
  2079. {
  2080. # if it's a switch that takes an argument
  2081. if ( $opt->{$1} )
  2082. {
  2083. # If this switch has already been provided
  2084. if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
  2085. {
  2086. $state->{opt}{$1} = [ $state->{opt}{$1} ];
  2087. if ( length($2) > 0 )
  2088. {
  2089. push @{$state->{opt}{$1}},$2;
  2090. } else {
  2091. push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
  2092. }
  2093. } else {
  2094. # if there's extra data in the arg, use that as the argument for the switch
  2095. if ( length($2) > 0 )
  2096. {
  2097. $state->{opt}{$1} = $2;
  2098. } else {
  2099. $state->{opt}{$1} = shift @{$state->{arguments}};
  2100. }
  2101. }
  2102. } else {
  2103. $state->{opt}{$1} = undef;
  2104. }
  2105. }
  2106. else
  2107. {
  2108. push @{$state->{args}}, $arg;
  2109. }
  2110. }
  2111. }
  2112. else
  2113. {
  2114. my $mode = 0;
  2115. foreach my $value ( @{$state->{arguments}} )
  2116. {
  2117. if ( $value eq "--" )
  2118. {
  2119. $mode++;
  2120. next;
  2121. }
  2122. push @{$state->{args}}, $value if ( $mode == 0 );
  2123. push @{$state->{files}}, $value if ( $mode == 1 );
  2124. }
  2125. }
  2126. }
  2127. # Used by argsfromdir
  2128. sub expandArg
  2129. {
  2130. my ($updater,$outNameMap,$outDirMap,$path,$isDir) = @_;
  2131. my $fullPath = filecleanup($path);
  2132. # Is it a directory?
  2133. if( defined($state->{dirMap}{$fullPath}) ||
  2134. defined($state->{dirMap}{"$fullPath/"}) )
  2135. {
  2136. # It is a directory in the user's sandbox.
  2137. $isDir=1;
  2138. if(defined($state->{entries}{$fullPath}))
  2139. {
  2140. $log->fatal("Inconsistent file/dir type");
  2141. die "Inconsistent file/dir type";
  2142. }
  2143. }
  2144. elsif(defined($state->{entries}{$fullPath}))
  2145. {
  2146. # It is a file in the user's sandbox.
  2147. $isDir=0;
  2148. }
  2149. my($revDirMap,$otherRevDirMap);
  2150. if(!defined($isDir) || $isDir)
  2151. {
  2152. # Resolve version tree for sticky tag:
  2153. # (for now we only want list of files for the version, not
  2154. # particular versions of those files: assume it is a directory
  2155. # for the moment; ignore Entry's stick tag)
  2156. # Order of precedence of sticky tags:
  2157. # -A [head]
  2158. # -r /tag/
  2159. # [file entry sticky tag, but that is only relevant to files]
  2160. # [the tag specified in dir req_Sticky]
  2161. # [the tag specified in a parent dir req_Sticky]
  2162. # [head]
  2163. # Also, -r may appear twice (for diff).
  2164. #
  2165. # FUTURE: When/if -j (merges) are supported, we also
  2166. # need to add relevant files from one or two
  2167. # versions specified with -j.
  2168. if(exists($state->{opt}{A}))
  2169. {
  2170. $revDirMap=$updater->getRevisionDirMap();
  2171. }
  2172. elsif( defined($state->{opt}{r}) and
  2173. ref $state->{opt}{r} eq "ARRAY" )
  2174. {
  2175. $revDirMap=$updater->getRevisionDirMap($state->{opt}{r}[0]);
  2176. $otherRevDirMap=$updater->getRevisionDirMap($state->{opt}{r}[1]);
  2177. }
  2178. elsif(defined($state->{opt}{r}))
  2179. {
  2180. $revDirMap=$updater->getRevisionDirMap($state->{opt}{r});
  2181. }
  2182. else
  2183. {
  2184. my($sticky)=getDirStickyInfo($fullPath);
  2185. $revDirMap=$updater->getRevisionDirMap($sticky->{tag});
  2186. }
  2187. # Is it a directory?
  2188. if( defined($revDirMap->{$fullPath}) ||
  2189. defined($otherRevDirMap->{$fullPath}) )
  2190. {
  2191. $isDir=1;
  2192. }
  2193. }
  2194. # What to do with it?
  2195. if(!$isDir)
  2196. {
  2197. $outNameMap->{$fullPath}=1;
  2198. }
  2199. else
  2200. {
  2201. $outDirMap->{$fullPath}=1;
  2202. if(defined($revDirMap->{$fullPath}))
  2203. {
  2204. addDirMapFiles($updater,$outNameMap,$outDirMap,
  2205. $revDirMap->{$fullPath});
  2206. }
  2207. if( defined($otherRevDirMap) &&
  2208. defined($otherRevDirMap->{$fullPath}) )
  2209. {
  2210. addDirMapFiles($updater,$outNameMap,$outDirMap,
  2211. $otherRevDirMap->{$fullPath});
  2212. }
  2213. }
  2214. }
  2215. # Used by argsfromdir
  2216. # Add entries from dirMap to outNameMap. Also recurse into entries
  2217. # that are subdirectories.
  2218. sub addDirMapFiles
  2219. {
  2220. my($updater,$outNameMap,$outDirMap,$dirMap)=@_;
  2221. my($fullName);
  2222. foreach $fullName (keys(%$dirMap))
  2223. {
  2224. my $cleanName=$fullName;
  2225. if(defined($state->{prependdir}))
  2226. {
  2227. if(!($cleanName=~s/^\Q$state->{prependdir}\E//))
  2228. {
  2229. $log->fatal("internal error stripping prependdir");
  2230. die "internal error stripping prependdir";
  2231. }
  2232. }
  2233. if($dirMap->{$fullName} eq "F")
  2234. {
  2235. $outNameMap->{$cleanName}=1;
  2236. }
  2237. elsif($dirMap->{$fullName} eq "D")
  2238. {
  2239. if(!$state->{opt}{l})
  2240. {
  2241. expandArg($updater,$outNameMap,$outDirMap,$cleanName,1);
  2242. }
  2243. }
  2244. else
  2245. {
  2246. $log->fatal("internal error in addDirMapFiles");
  2247. die "internal error in addDirMapFiles";
  2248. }
  2249. }
  2250. }
  2251. # This method replaces $state->{args} with a directory-expanded
  2252. # list of all relevant filenames (recursively unless -d), based
  2253. # on $state->{entries}, and the "current" list of files in
  2254. # each directory. "Current" files as determined by
  2255. # either the requested (-r/-A) or "req_Sticky" version of
  2256. # that directory.
  2257. # Both the input args and the new output args are relative
  2258. # to the cvs-client's CWD, although some of the internal
  2259. # computations are relative to the top of the project.
  2260. sub argsfromdir
  2261. {
  2262. my $updater = shift;
  2263. # Notes about requirements for specific callers:
  2264. # update # "standard" case (entries; a single -r/-A/default; -l)
  2265. # # Special case: -d for create missing directories.
  2266. # diff # 0 or 1 -r's: "standard" case.
  2267. # # 2 -r's: We could ignore entries (just use the two -r's),
  2268. # # but it doesn't really matter.
  2269. # annotate # "standard" case
  2270. # log # Punting: log -r has a more complex non-"standard"
  2271. # # meaning, and we don't currently try to support log'ing
  2272. # # branches at all (need a lot of work to
  2273. # # support CVS-consistent branch relative version
  2274. # # numbering).
  2275. #HERE: But we still want to expand directories. Maybe we should
  2276. # essentially force "-A".
  2277. # status # "standard", except that -r/-A/default are not possible.
  2278. # # Mostly only used to expand entries only)
  2279. #
  2280. # Don't use argsfromdir at all:
  2281. # add # Explicit arguments required. Directory args imply add
  2282. # # the directory itself, not the files in it.
  2283. # co # Obtain list directly.
  2284. # remove # HERE: TEST: MAYBE client does the recursion for us,
  2285. # # since it only makes sense to remove stuff already in
  2286. # # the sandbox?
  2287. # ci # HERE: Similar to remove...
  2288. # # Don't try to implement the confusing/weird
  2289. # # ci -r bug er.."feature".
  2290. if(scalar(@{$state->{args}})==0)
  2291. {
  2292. $state->{args} = [ "." ];
  2293. }
  2294. my %allArgs;
  2295. my %allDirs;
  2296. for my $file (@{$state->{args}})
  2297. {
  2298. expandArg($updater,\%allArgs,\%allDirs,$file);
  2299. }
  2300. # Include any entries from sandbox. Generally client won't
  2301. # send entries that shouldn't be used.
  2302. foreach my $file (keys %{$state->{entries}})
  2303. {
  2304. $allArgs{remove_prependdir($file)} = 1;
  2305. }
  2306. $state->{dirArgs} = \%allDirs;
  2307. $state->{args} = [
  2308. sort {
  2309. # Sort priority: by directory depth, then actual file name:
  2310. my @piecesA=split('/',$a);
  2311. my @piecesB=split('/',$b);
  2312. my $count=scalar(@piecesA);
  2313. my $tmp=scalar(@piecesB);
  2314. return $count<=>$tmp if($count!=$tmp);
  2315. for($tmp=0;$tmp<$count;$tmp++)
  2316. {
  2317. if($piecesA[$tmp] ne $piecesB[$tmp])
  2318. {
  2319. return $piecesA[$tmp] cmp $piecesB[$tmp]
  2320. }
  2321. }
  2322. return 0;
  2323. } keys(%allArgs) ];
  2324. }
  2325. ## look up directory sticky tag, of either fullPath or a parent:
  2326. sub getDirStickyInfo
  2327. {
  2328. my($fullPath)=@_;
  2329. $fullPath=~s%/+$%%;
  2330. while($fullPath ne "" && !defined($state->{dirMap}{"$fullPath/"}))
  2331. {
  2332. $fullPath=~s%/?[^/]*$%%;
  2333. }
  2334. if( !defined($state->{dirMap}{"$fullPath/"}) &&
  2335. ( $fullPath eq "" ||
  2336. $fullPath eq "." ) )
  2337. {
  2338. return $state->{dirMap}{""}{stickyInfo};
  2339. }
  2340. else
  2341. {
  2342. return $state->{dirMap}{"$fullPath/"}{stickyInfo};
  2343. }
  2344. }
  2345. # Resolve precedence of various ways of specifying which version of
  2346. # a file you want. Returns undef (for default head), or a ref to a hash
  2347. # that contains "tag" and/or "date" keys.
  2348. sub resolveStickyInfo
  2349. {
  2350. my($filename,$stickyTag,$stickyDate,$reset) = @_;
  2351. # Order of precedence of sticky tags:
  2352. # -A [head]
  2353. # -r /tag/
  2354. # [file entry sticky tag]
  2355. # [the tag specified in dir req_Sticky]
  2356. # [the tag specified in a parent dir req_Sticky]
  2357. # [head]
  2358. my $result;
  2359. if($reset)
  2360. {
  2361. # $result=undef;
  2362. }
  2363. elsif( defined($stickyTag) && $stickyTag ne "" )
  2364. # || ( defined($stickyDate) && $stickyDate ne "" ) # TODO
  2365. {
  2366. $result={ 'tag' => (defined($stickyTag)?$stickyTag:undef) };
  2367. # TODO: Convert -D value into the form 2011.04.10.04.46.57,
  2368. # similar to an entry line's sticky date, without the D prefix.
  2369. # It sometimes (always?) arrives as something more like
  2370. # '10 Apr 2011 04:46:57 -0000'...
  2371. # $result={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
  2372. }
  2373. elsif( defined($state->{entries}{$filename}) &&
  2374. defined($state->{entries}{$filename}{tag_or_date}) &&
  2375. $state->{entries}{$filename}{tag_or_date} ne "" )
  2376. {
  2377. my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
  2378. if($tagOrDate=~/^T([^ ]+)\s*$/)
  2379. {
  2380. $result = { 'tag' => $1 };
  2381. }
  2382. elsif($tagOrDate=~/^D([0-9.]+)\s*$/)
  2383. {
  2384. $result= { 'date' => $1 };
  2385. }
  2386. else
  2387. {
  2388. die "Unknown tag_or_date format\n";
  2389. }
  2390. }
  2391. else
  2392. {
  2393. $result=getDirStickyInfo($filename);
  2394. }
  2395. return $result;
  2396. }
  2397. # Convert a stickyInfo (ref to a hash) as returned by resolveStickyInfo into
  2398. # a form appropriate for the sticky tag field of an Entries
  2399. # line (field index 5, 0-based).
  2400. sub getStickyTagOrDate
  2401. {
  2402. my($stickyInfo)=@_;
  2403. my $result;
  2404. if(defined($stickyInfo) && defined($stickyInfo->{tag}))
  2405. {
  2406. $result="T$stickyInfo->{tag}";
  2407. }
  2408. # TODO: When/if we actually pick versions by {date} properly,
  2409. # also handle it here:
  2410. # "D$stickyInfo->{date}" (example: "D2011.04.13.20.37.07").
  2411. else
  2412. {
  2413. $result="";
  2414. }
  2415. return $result;
  2416. }
  2417. # This method cleans up the $state variable after a command that uses arguments has run
  2418. sub statecleanup
  2419. {
  2420. $state->{files} = [];
  2421. $state->{dirArgs} = {};
  2422. $state->{args} = [];
  2423. $state->{arguments} = [];
  2424. $state->{entries} = {};
  2425. $state->{dirMap} = {};
  2426. }
  2427. # Return working directory CVS revision "1.X" out
  2428. # of the working directory "entries" state, for the given filename.
  2429. # This is prefixed with a dash if the file is scheduled for removal
  2430. # when it is committed.
  2431. sub revparse
  2432. {
  2433. my $filename = shift;
  2434. return $state->{entries}{$filename}{revision};
  2435. }
  2436. # This method takes a file hash and does a CVS "file transfer". Its
  2437. # exact behaviour depends on a second, optional hash table argument:
  2438. # - If $options->{targetfile}, dump the contents to that file;
  2439. # - If $options->{print}, use M/MT to transmit the contents one line
  2440. # at a time;
  2441. # - Otherwise, transmit the size of the file, followed by the file
  2442. # contents.
  2443. sub transmitfile
  2444. {
  2445. my $filehash = shift;
  2446. my $options = shift;
  2447. if ( defined ( $filehash ) and $filehash eq "deleted" )
  2448. {
  2449. $log->warn("filehash is 'deleted'");
  2450. return;
  2451. }
  2452. die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
  2453. my $type = safe_pipe_capture('git', 'cat-file', '-t', $filehash);
  2454. chomp $type;
  2455. die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
  2456. my $size = safe_pipe_capture('git', 'cat-file', '-s', $filehash);
  2457. chomp $size;
  2458. $log->debug("transmitfile($filehash) size=$size, type=$type");
  2459. if ( open my $fh, '-|', "git", "cat-file", "blob", $filehash )
  2460. {
  2461. if ( defined ( $options->{targetfile} ) )
  2462. {
  2463. my $targetfile = $options->{targetfile};
  2464. open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
  2465. print NEWFILE $_ while ( <$fh> );
  2466. close NEWFILE or die("Failed to write '$targetfile': $!");
  2467. } elsif ( defined ( $options->{print} ) && $options->{print} ) {
  2468. while ( <$fh> ) {
  2469. if( /\n\z/ ) {
  2470. print 'M ', $_;
  2471. } else {
  2472. print 'MT text ', $_, "\n";
  2473. }
  2474. }
  2475. } else {
  2476. print "$size\n";
  2477. print while ( <$fh> );
  2478. }
  2479. close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
  2480. } else {
  2481. die("Couldn't execute git-cat-file");
  2482. }
  2483. }
  2484. # This method takes a file name, and returns ( $dirpart, $filepart ) which
  2485. # refers to the directory portion and the file portion of the filename
  2486. # respectively
  2487. sub filenamesplit
  2488. {
  2489. my $filename = shift;
  2490. my $fixforlocaldir = shift;
  2491. my ( $filepart, $dirpart ) = ( $filename, "." );
  2492. ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
  2493. $dirpart .= "/";
  2494. if ( $fixforlocaldir )
  2495. {
  2496. $dirpart =~ s/^$state->{prependdir}//;
  2497. }
  2498. return ( $filepart, $dirpart );
  2499. }
  2500. # Cleanup various junk in filename (try to canonicalize it), and
  2501. # add prependdir to accommodate running CVS client from a
  2502. # subdirectory (so the output is relative to top directory of the project).
  2503. sub filecleanup
  2504. {
  2505. my $filename = shift;
  2506. return undef unless(defined($filename));
  2507. if ( $filename =~ /^\// )
  2508. {
  2509. print "E absolute filenames '$filename' not supported by server\n";
  2510. return undef;
  2511. }
  2512. if($filename eq ".")
  2513. {
  2514. $filename="";
  2515. }
  2516. $filename =~ s/^\.\///g;
  2517. $filename =~ s%/+%/%g;
  2518. $filename = $state->{prependdir} . $filename;
  2519. $filename =~ s%/$%%;
  2520. return $filename;
  2521. }
  2522. # Remove prependdir from the path, so that it is relative to the directory
  2523. # the CVS client was started from, rather than the top of the project.
  2524. # Essentially the inverse of filecleanup().
  2525. sub remove_prependdir
  2526. {
  2527. my($path) = @_;
  2528. if(defined($state->{prependdir}) && $state->{prependdir} ne "")
  2529. {
  2530. my($pre)=$state->{prependdir};
  2531. $pre=~s%/$%%;
  2532. if(!($path=~s%^\Q$pre\E/?%%))
  2533. {
  2534. $log->fatal("internal error missing prependdir");
  2535. die("internal error missing prependdir");
  2536. }
  2537. }
  2538. return $path;
  2539. }
  2540. sub validateGitDir
  2541. {
  2542. if( !defined($state->{CVSROOT}) )
  2543. {
  2544. print "error 1 CVSROOT not specified\n";
  2545. cleanupWorkTree();
  2546. exit;
  2547. }
  2548. if( $ENV{GIT_DIR} ne ($state->{CVSROOT} . '/') )
  2549. {
  2550. print "error 1 Internally inconsistent CVSROOT\n";
  2551. cleanupWorkTree();
  2552. exit;
  2553. }
  2554. }
  2555. # Setup working directory in a work tree with the requested version
  2556. # loaded in the index.
  2557. sub setupWorkTree
  2558. {
  2559. my ($ver) = @_;
  2560. validateGitDir();
  2561. if( ( defined($work->{state}) && $work->{state} != 1 ) ||
  2562. defined($work->{tmpDir}) )
  2563. {
  2564. $log->warn("Bad work tree state management");
  2565. print "error 1 Internal setup multiple work trees without cleanup\n";
  2566. cleanupWorkTree();
  2567. exit;
  2568. }
  2569. $work->{workDir} = tempdir ( DIR => $TEMP_DIR );
  2570. if( !defined($work->{index}) )
  2571. {
  2572. (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
  2573. }
  2574. chdir $work->{workDir} or
  2575. die "Unable to chdir to $work->{workDir}\n";
  2576. $log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");
  2577. $ENV{GIT_WORK_TREE} = ".";
  2578. $ENV{GIT_INDEX_FILE} = $work->{index};
  2579. $work->{state} = 2;
  2580. if($ver)
  2581. {
  2582. system("git","read-tree",$ver);
  2583. unless ($? == 0)
  2584. {
  2585. $log->warn("Error running git-read-tree");
  2586. die "Error running git-read-tree $ver in $work->{workDir} $!\n";
  2587. }
  2588. }
  2589. # else # req_annotate reads tree for each file
  2590. }
  2591. # Ensure current directory is in some kind of working directory,
  2592. # with a recent version loaded in the index.
  2593. sub ensureWorkTree
  2594. {
  2595. if( defined($work->{tmpDir}) )
  2596. {
  2597. $log->warn("Bad work tree state management [ensureWorkTree()]");
  2598. print "error 1 Internal setup multiple dirs without cleanup\n";
  2599. cleanupWorkTree();
  2600. exit;
  2601. }
  2602. if( $work->{state} )
  2603. {
  2604. return;
  2605. }
  2606. validateGitDir();
  2607. if( !defined($work->{emptyDir}) )
  2608. {
  2609. $work->{emptyDir} = tempdir ( DIR => $TEMP_DIR, OPEN => 0);
  2610. }
  2611. chdir $work->{emptyDir} or
  2612. die "Unable to chdir to $work->{emptyDir}\n";
  2613. my $ver = safe_pipe_capture('git', 'show-ref', '-s', "refs/heads/$state->{module}");
  2614. chomp $ver;
  2615. if ($ver !~ /^[0-9a-f]{40}$/)
  2616. {
  2617. $log->warn("Error from git show-ref -s refs/head$state->{module}");
  2618. print "error 1 cannot find the current HEAD of module";
  2619. cleanupWorkTree();
  2620. exit;
  2621. }
  2622. if( !defined($work->{index}) )
  2623. {
  2624. (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
  2625. }
  2626. $ENV{GIT_WORK_TREE} = ".";
  2627. $ENV{GIT_INDEX_FILE} = $work->{index};
  2628. $work->{state} = 1;
  2629. system("git","read-tree",$ver);
  2630. unless ($? == 0)
  2631. {
  2632. die "Error running git-read-tree $ver $!\n";
  2633. }
  2634. }
  2635. # Cleanup working directory that is not needed any longer.
  2636. sub cleanupWorkTree
  2637. {
  2638. if( ! $work->{state} )
  2639. {
  2640. return;
  2641. }
  2642. chdir "/" or die "Unable to chdir '/'\n";
  2643. if( defined($work->{workDir}) )
  2644. {
  2645. rmtree( $work->{workDir} );
  2646. undef $work->{workDir};
  2647. }
  2648. undef $work->{state};
  2649. }
  2650. # Setup a temporary directory (not a working tree), typically for
  2651. # merging dirty state as in req_update.
  2652. sub setupTmpDir
  2653. {
  2654. $work->{tmpDir} = tempdir ( DIR => $TEMP_DIR );
  2655. chdir $work->{tmpDir} or die "Unable to chdir $work->{tmpDir}\n";
  2656. return $work->{tmpDir};
  2657. }
  2658. # Clean up a previously setupTmpDir. Restore previous work tree if
  2659. # appropriate.
  2660. sub cleanupTmpDir
  2661. {
  2662. if ( !defined($work->{tmpDir}) )
  2663. {
  2664. $log->warn("cleanup tmpdir that has not been setup");
  2665. die "Cleanup tmpDir that has not been setup\n";
  2666. }
  2667. if( defined($work->{state}) )
  2668. {
  2669. if( $work->{state} == 1 )
  2670. {
  2671. chdir $work->{emptyDir} or
  2672. die "Unable to chdir to $work->{emptyDir}\n";
  2673. }
  2674. elsif( $work->{state} == 2 )
  2675. {
  2676. chdir $work->{workDir} or
  2677. die "Unable to chdir to $work->{emptyDir}\n";
  2678. }
  2679. else
  2680. {
  2681. $log->warn("Inconsistent work dir state");
  2682. die "Inconsistent work dir state\n";
  2683. }
  2684. }
  2685. else
  2686. {
  2687. chdir "/" or die "Unable to chdir '/'\n";
  2688. }
  2689. }
  2690. # Given a path, this function returns a string containing the kopts
  2691. # that should go into that path's Entries line. For example, a binary
  2692. # file should get -kb.
  2693. sub kopts_from_path
  2694. {
  2695. my ($path, $srcType, $name) = @_;
  2696. if ( defined ( $cfg->{gitcvs}{usecrlfattr} ) and
  2697. $cfg->{gitcvs}{usecrlfattr} =~ /\s*(1|true|yes)\s*$/i )
  2698. {
  2699. my ($val) = check_attr( "text", $path );
  2700. if ( $val eq "unspecified" )
  2701. {
  2702. $val = check_attr( "crlf", $path );
  2703. }
  2704. if ( $val eq "unset" )
  2705. {
  2706. return "-kb"
  2707. }
  2708. elsif ( check_attr( "eol", $path ) ne "unspecified" ||
  2709. $val eq "set" || $val eq "input" )
  2710. {
  2711. return "";
  2712. }
  2713. else
  2714. {
  2715. $log->info("Unrecognized check_attr crlf $path : $val");
  2716. }
  2717. }
  2718. if ( defined ( $cfg->{gitcvs}{allbinary} ) )
  2719. {
  2720. if( ($cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i) )
  2721. {
  2722. return "-kb";
  2723. }
  2724. elsif( ($cfg->{gitcvs}{allbinary} =~ /^\s*guess\s*$/i) )
  2725. {
  2726. if( is_binary($srcType,$name) )
  2727. {
  2728. $log->debug("... as binary");
  2729. return "-kb";
  2730. }
  2731. else
  2732. {
  2733. $log->debug("... as text");
  2734. }
  2735. }
  2736. }
  2737. # Return "" to give no special treatment to any path
  2738. return "";
  2739. }
  2740. sub check_attr
  2741. {
  2742. my ($attr,$path) = @_;
  2743. ensureWorkTree();
  2744. if ( open my $fh, '-|', "git", "check-attr", $attr, "--", $path )
  2745. {
  2746. my $val = <$fh>;
  2747. close $fh;
  2748. $val =~ s/.*: ([^:\r\n]*)\s*$/$1/;
  2749. return $val;
  2750. }
  2751. else
  2752. {
  2753. return undef;
  2754. }
  2755. }
  2756. # This should have the same heuristics as convert.c:is_binary() and related.
  2757. # Note that the bare CR test is done by callers in convert.c.
  2758. sub is_binary
  2759. {
  2760. my ($srcType,$name) = @_;
  2761. $log->debug("is_binary($srcType,$name)");
  2762. # Minimize amount of interpreted code run in the inner per-character
  2763. # loop for large files, by totalling each character value and
  2764. # then analyzing the totals.
  2765. my @counts;
  2766. my $i;
  2767. for($i=0;$i<256;$i++)
  2768. {
  2769. $counts[$i]=0;
  2770. }
  2771. my $fh = open_blob_or_die($srcType,$name);
  2772. my $line;
  2773. while( defined($line=<$fh>) )
  2774. {
  2775. # Any '\0' and bare CR are considered binary.
  2776. if( $line =~ /\0|(\r[^\n])/ )
  2777. {
  2778. close($fh);
  2779. return 1;
  2780. }
  2781. # Count up each character in the line:
  2782. my $len=length($line);
  2783. for($i=0;$i<$len;$i++)
  2784. {
  2785. $counts[ord(substr($line,$i,1))]++;
  2786. }
  2787. }
  2788. close $fh;
  2789. # Don't count CR and LF as either printable/nonprintable
  2790. $counts[ord("\n")]=0;
  2791. $counts[ord("\r")]=0;
  2792. # Categorize individual character count into printable and nonprintable:
  2793. my $printable=0;
  2794. my $nonprintable=0;
  2795. for($i=0;$i<256;$i++)
  2796. {
  2797. if( $i < 32 &&
  2798. $i != ord("\b") &&
  2799. $i != ord("\t") &&
  2800. $i != 033 && # ESC
  2801. $i != 014 ) # FF
  2802. {
  2803. $nonprintable+=$counts[$i];
  2804. }
  2805. elsif( $i==127 ) # DEL
  2806. {
  2807. $nonprintable+=$counts[$i];
  2808. }
  2809. else
  2810. {
  2811. $printable+=$counts[$i];
  2812. }
  2813. }
  2814. return ($printable >> 7) < $nonprintable;
  2815. }
  2816. # Returns open file handle. Possible invocations:
  2817. # - open_blob_or_die("file",$filename);
  2818. # - open_blob_or_die("sha1",$filehash);
  2819. sub open_blob_or_die
  2820. {
  2821. my ($srcType,$name) = @_;
  2822. my ($fh);
  2823. if( $srcType eq "file" )
  2824. {
  2825. if( !open $fh,"<",$name )
  2826. {
  2827. $log->warn("Unable to open file $name: $!");
  2828. die "Unable to open file $name: $!\n";
  2829. }
  2830. }
  2831. elsif( $srcType eq "sha1" )
  2832. {
  2833. unless ( defined ( $name ) and $name =~ /^[a-zA-Z0-9]{40}$/ )
  2834. {
  2835. $log->warn("Need filehash");
  2836. die "Need filehash\n";
  2837. }
  2838. my $type = safe_pipe_capture('git', 'cat-file', '-t', $name);
  2839. chomp $type;
  2840. unless ( defined ( $type ) and $type eq "blob" )
  2841. {
  2842. $log->warn("Invalid type '$type' for '$name'");
  2843. die ( "Invalid type '$type' (expected 'blob')" )
  2844. }
  2845. my $size = safe_pipe_capture('git', 'cat-file', '-s', $name);
  2846. chomp $size;
  2847. $log->debug("open_blob_or_die($name) size=$size, type=$type");
  2848. unless( open $fh, '-|', "git", "cat-file", "blob", $name )
  2849. {
  2850. $log->warn("Unable to open sha1 $name");
  2851. die "Unable to open sha1 $name\n";
  2852. }
  2853. }
  2854. else
  2855. {
  2856. $log->warn("Unknown type of blob source: $srcType");
  2857. die "Unknown type of blob source: $srcType\n";
  2858. }
  2859. return $fh;
  2860. }
  2861. # Generate a CVS author name from Git author information, by taking the local
  2862. # part of the email address and replacing characters not in the Portable
  2863. # Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS
  2864. # Login names are Unix login names, which should be restricted to this
  2865. # character set.
  2866. sub cvs_author
  2867. {
  2868. my $author_line = shift;
  2869. (my $author) = $author_line =~ /<([^@>]*)/;
  2870. $author =~ s/[^-a-zA-Z0-9_.]/_/g;
  2871. $author =~ s/^-/_/;
  2872. $author;
  2873. }
  2874. sub descramble
  2875. {
  2876. # This table is from src/scramble.c in the CVS source
  2877. my @SHIFTS = (
  2878. 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
  2879. 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
  2880. 114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
  2881. 111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
  2882. 41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
  2883. 125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
  2884. 36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
  2885. 58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
  2886. 225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
  2887. 199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
  2888. 174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
  2889. 207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
  2890. 192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
  2891. 227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
  2892. 182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
  2893. 243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
  2894. );
  2895. my ($str) = @_;
  2896. # This should never happen, the same password format (A) has been
  2897. # used by CVS since the beginning of time
  2898. {
  2899. my $fmt = substr($str, 0, 1);
  2900. die "invalid password format `$fmt'" unless $fmt eq 'A';
  2901. }
  2902. my @str = unpack "C*", substr($str, 1);
  2903. my $ret = join '', map { chr $SHIFTS[$_] } @str;
  2904. return $ret;
  2905. }
  2906. # Test if the (deep) values of two references to a hash are the same.
  2907. sub refHashEqual
  2908. {
  2909. my($v1,$v2) = @_;
  2910. my $out;
  2911. if(!defined($v1))
  2912. {
  2913. if(!defined($v2))
  2914. {
  2915. $out=1;
  2916. }
  2917. }
  2918. elsif( !defined($v2) ||
  2919. scalar(keys(%{$v1})) != scalar(keys(%{$v2})) )
  2920. {
  2921. # $out=undef;
  2922. }
  2923. else
  2924. {
  2925. $out=1;
  2926. my $key;
  2927. foreach $key (keys(%{$v1}))
  2928. {
  2929. if( !exists($v2->{$key}) ||
  2930. defined($v1->{$key}) ne defined($v2->{$key}) ||
  2931. ( defined($v1->{$key}) &&
  2932. $v1->{$key} ne $v2->{$key} ) )
  2933. {
  2934. $out=undef;
  2935. last;
  2936. }
  2937. }
  2938. }
  2939. return $out;
  2940. }
  2941. # an alternative to `command` that allows input to be passed as an array
  2942. # to work around shell problems with weird characters in arguments
  2943. sub safe_pipe_capture {
  2944. my @output;
  2945. if (my $pid = open my $child, '-|') {
  2946. @output = (<$child>);
  2947. close $child or die join(' ',@_).": $! $?";
  2948. } else {
  2949. exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
  2950. }
  2951. return wantarray ? @output : join('',@output);
  2952. }
  2953. package GITCVS::log;
  2954. ####
  2955. #### Copyright The Open University UK - 2006.
  2956. ####
  2957. #### Authors: Martyn Smith <martyn@catalyst.net.nz>
  2958. #### Martin Langhoff <martin@laptop.org>
  2959. ####
  2960. ####
  2961. use strict;
  2962. use warnings;
  2963. =head1 NAME
  2964. GITCVS::log
  2965. =head1 DESCRIPTION
  2966. This module provides very crude logging with a similar interface to
  2967. Log::Log4perl
  2968. =head1 METHODS
  2969. =cut
  2970. =head2 new
  2971. Creates a new log object, optionally you can specify a filename here to
  2972. indicate the file to log to. If no log file is specified, you can specify one
  2973. later with method setfile, or indicate you no longer want logging with method
  2974. nofile.
  2975. Until one of these methods is called, all log calls will buffer messages ready
  2976. to write out.
  2977. =cut
  2978. sub new
  2979. {
  2980. my $class = shift;
  2981. my $filename = shift;
  2982. my $self = {};
  2983. bless $self, $class;
  2984. if ( defined ( $filename ) )
  2985. {
  2986. open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
  2987. }
  2988. return $self;
  2989. }
  2990. =head2 setfile
  2991. This methods takes a filename, and attempts to open that file as the log file.
  2992. If successful, all buffered data is written out to the file, and any further
  2993. logging is written directly to the file.
  2994. =cut
  2995. sub setfile
  2996. {
  2997. my $self = shift;
  2998. my $filename = shift;
  2999. if ( defined ( $filename ) )
  3000. {
  3001. open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
  3002. }
  3003. return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
  3004. while ( my $line = shift @{$self->{buffer}} )
  3005. {
  3006. print {$self->{fh}} $line;
  3007. }
  3008. }
  3009. =head2 nofile
  3010. This method indicates no logging is going to be used. It flushes any entries in
  3011. the internal buffer, and sets a flag to ensure no further data is put there.
  3012. =cut
  3013. sub nofile
  3014. {
  3015. my $self = shift;
  3016. $self->{nolog} = 1;
  3017. return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
  3018. $self->{buffer} = [];
  3019. }
  3020. =head2 _logopen
  3021. Internal method. Returns true if the log file is open, false otherwise.
  3022. =cut
  3023. sub _logopen
  3024. {
  3025. my $self = shift;
  3026. return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
  3027. return 0;
  3028. }
  3029. =head2 debug info warn fatal
  3030. These four methods are wrappers to _log. They provide the actual interface for
  3031. logging data.
  3032. =cut
  3033. sub debug { my $self = shift; $self->_log("debug", @_); }
  3034. sub info { my $self = shift; $self->_log("info" , @_); }
  3035. sub warn { my $self = shift; $self->_log("warn" , @_); }
  3036. sub fatal { my $self = shift; $self->_log("fatal", @_); }
  3037. =head2 _log
  3038. This is an internal method called by the logging functions. It generates a
  3039. timestamp and pushes the logged line either to file, or internal buffer.
  3040. =cut
  3041. sub _log
  3042. {
  3043. my $self = shift;
  3044. my $level = shift;
  3045. return if ( $self->{nolog} );
  3046. my @time = localtime;
  3047. my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
  3048. $time[5] + 1900,
  3049. $time[4] + 1,
  3050. $time[3],
  3051. $time[2],
  3052. $time[1],
  3053. $time[0],
  3054. uc $level,
  3055. );
  3056. if ( $self->_logopen )
  3057. {
  3058. print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
  3059. } else {
  3060. push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
  3061. }
  3062. }
  3063. =head2 DESTROY
  3064. This method simply closes the file handle if one is open
  3065. =cut
  3066. sub DESTROY
  3067. {
  3068. my $self = shift;
  3069. if ( $self->_logopen )
  3070. {
  3071. close $self->{fh};
  3072. }
  3073. }
  3074. package GITCVS::updater;
  3075. ####
  3076. #### Copyright The Open University UK - 2006.
  3077. ####
  3078. #### Authors: Martyn Smith <martyn@catalyst.net.nz>
  3079. #### Martin Langhoff <martin@laptop.org>
  3080. ####
  3081. ####
  3082. use strict;
  3083. use warnings;
  3084. use DBI;
  3085. =head1 METHODS
  3086. =cut
  3087. =head2 new
  3088. =cut
  3089. sub new
  3090. {
  3091. my $class = shift;
  3092. my $config = shift;
  3093. my $module = shift;
  3094. my $log = shift;
  3095. die "Need to specify a git repository" unless ( defined($config) and -d $config );
  3096. die "Need to specify a module" unless ( defined($module) );
  3097. $class = ref($class) || $class;
  3098. my $self = {};
  3099. bless $self, $class;
  3100. $self->{valid_tables} = {'revision' => 1,
  3101. 'revision_ix1' => 1,
  3102. 'revision_ix2' => 1,
  3103. 'head' => 1,
  3104. 'head_ix1' => 1,
  3105. 'properties' => 1,
  3106. 'commitmsgs' => 1};
  3107. $self->{module} = $module;
  3108. $self->{git_path} = $config . "/";
  3109. $self->{log} = $log;
  3110. die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
  3111. # Stores full sha1's for various branch/tag names, abbreviations, etc:
  3112. $self->{commitRefCache} = {};
  3113. $self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
  3114. $cfg->{gitcvs}{dbdriver} || "SQLite";
  3115. $self->{dbname} = $cfg->{gitcvs}{$state->{method}}{dbname} ||
  3116. $cfg->{gitcvs}{dbname} || "%Ggitcvs.%m.sqlite";
  3117. $self->{dbuser} = $cfg->{gitcvs}{$state->{method}}{dbuser} ||
  3118. $cfg->{gitcvs}{dbuser} || "";
  3119. $self->{dbpass} = $cfg->{gitcvs}{$state->{method}}{dbpass} ||
  3120. $cfg->{gitcvs}{dbpass} || "";
  3121. $self->{dbtablenameprefix} = $cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||
  3122. $cfg->{gitcvs}{dbtablenameprefix} || "";
  3123. my %mapping = ( m => $module,
  3124. a => $state->{method},
  3125. u => getlogin || getpwuid($<) || $<,
  3126. G => $self->{git_path},
  3127. g => mangle_dirname($self->{git_path}),
  3128. );
  3129. $self->{dbname} =~ s/%([mauGg])/$mapping{$1}/eg;
  3130. $self->{dbuser} =~ s/%([mauGg])/$mapping{$1}/eg;
  3131. $self->{dbtablenameprefix} =~ s/%([mauGg])/$mapping{$1}/eg;
  3132. $self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});
  3133. die "Invalid char ':' in dbdriver" if $self->{dbdriver} =~ /:/;
  3134. die "Invalid char ';' in dbname" if $self->{dbname} =~ /;/;
  3135. $self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
  3136. $self->{dbuser},
  3137. $self->{dbpass});
  3138. die "Error connecting to database\n" unless defined $self->{dbh};
  3139. $self->{tables} = {};
  3140. foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
  3141. {
  3142. $self->{tables}{$table} = 1;
  3143. }
  3144. # Construct the revision table if required
  3145. # The revision table stores an entry for each file, each time that file
  3146. # changes.
  3147. # numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )
  3148. # This is not sufficient to support "-r {commithash}" for any
  3149. # files except files that were modified by that commit (also,
  3150. # some places in the code ignore/effectively strip out -r in
  3151. # some cases, before it gets passed to getmeta()).
  3152. # The "filehash" field typically has a git blob hash, but can also
  3153. # be set to "dead" to indicate that the given version of the file
  3154. # should not exist in the sandbox.
  3155. unless ( $self->{tables}{$self->tablename("revision")} )
  3156. {
  3157. my $tablename = $self->tablename("revision");
  3158. my $ix1name = $self->tablename("revision_ix1");
  3159. my $ix2name = $self->tablename("revision_ix2");
  3160. $self->{dbh}->do("
  3161. CREATE TABLE $tablename (
  3162. name TEXT NOT NULL,
  3163. revision INTEGER NOT NULL,
  3164. filehash TEXT NOT NULL,
  3165. commithash TEXT NOT NULL,
  3166. author TEXT NOT NULL,
  3167. modified TEXT NOT NULL,
  3168. mode TEXT NOT NULL
  3169. )
  3170. ");
  3171. $self->{dbh}->do("
  3172. CREATE INDEX $ix1name
  3173. ON $tablename (name,revision)
  3174. ");
  3175. $self->{dbh}->do("
  3176. CREATE INDEX $ix2name
  3177. ON $tablename (name,commithash)
  3178. ");
  3179. }
  3180. # Construct the head table if required
  3181. # The head table (along with the "last_commit" entry in the property
  3182. # table) is the persisted working state of the "sub update" subroutine.
  3183. # All of it's data is read entirely first, and completely recreated
  3184. # last, every time "sub update" runs.
  3185. # This is also used by "sub getmeta" when it is asked for the latest
  3186. # version of a file (as opposed to some specific version).
  3187. # Another way of thinking about it is as a single slice out of
  3188. # "revisions", giving just the most recent revision information for
  3189. # each file.
  3190. unless ( $self->{tables}{$self->tablename("head")} )
  3191. {
  3192. my $tablename = $self->tablename("head");
  3193. my $ix1name = $self->tablename("head_ix1");
  3194. $self->{dbh}->do("
  3195. CREATE TABLE $tablename (
  3196. name TEXT NOT NULL,
  3197. revision INTEGER NOT NULL,
  3198. filehash TEXT NOT NULL,
  3199. commithash TEXT NOT NULL,
  3200. author TEXT NOT NULL,
  3201. modified TEXT NOT NULL,
  3202. mode TEXT NOT NULL
  3203. )
  3204. ");
  3205. $self->{dbh}->do("
  3206. CREATE INDEX $ix1name
  3207. ON $tablename (name)
  3208. ");
  3209. }
  3210. # Construct the properties table if required
  3211. # - "last_commit" - Used by "sub update".
  3212. unless ( $self->{tables}{$self->tablename("properties")} )
  3213. {
  3214. my $tablename = $self->tablename("properties");
  3215. $self->{dbh}->do("
  3216. CREATE TABLE $tablename (
  3217. key TEXT NOT NULL PRIMARY KEY,
  3218. value TEXT
  3219. )
  3220. ");
  3221. }
  3222. # Construct the commitmsgs table if required
  3223. # The commitmsgs table is only used for merge commits, since
  3224. # "sub update" will only keep one branch of parents. Shortlogs
  3225. # for ignored commits (i.e. not on the chosen branch) will be used
  3226. # to construct a replacement "collapsed" merge commit message,
  3227. # which will be stored in this table. See also "sub commitmessage".
  3228. unless ( $self->{tables}{$self->tablename("commitmsgs")} )
  3229. {
  3230. my $tablename = $self->tablename("commitmsgs");
  3231. $self->{dbh}->do("
  3232. CREATE TABLE $tablename (
  3233. key TEXT NOT NULL PRIMARY KEY,
  3234. value TEXT
  3235. )
  3236. ");
  3237. }
  3238. return $self;
  3239. }
  3240. =head2 tablename
  3241. =cut
  3242. sub tablename
  3243. {
  3244. my $self = shift;
  3245. my $name = shift;
  3246. if (exists $self->{valid_tables}{$name}) {
  3247. return $self->{dbtablenameprefix} . $name;
  3248. } else {
  3249. return undef;
  3250. }
  3251. }
  3252. =head2 update
  3253. Bring the database up to date with the latest changes from
  3254. the git repository.
  3255. Internal working state is read out of the "head" table and the
  3256. "last_commit" property, then it updates "revisions" based on that, and
  3257. finally it writes the new internal state back to the "head" table
  3258. so it can be used as a starting point the next time update is called.
  3259. =cut
  3260. sub update
  3261. {
  3262. my $self = shift;
  3263. # first lets get the commit list
  3264. $ENV{GIT_DIR} = $self->{git_path};
  3265. my $commitsha1 = ::safe_pipe_capture('git', 'rev-parse', $self->{module});
  3266. chomp $commitsha1;
  3267. my $commitinfo = ::safe_pipe_capture('git', 'cat-file', 'commit', $self->{module});
  3268. unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
  3269. {
  3270. die("Invalid module '$self->{module}'");
  3271. }
  3272. my $git_log;
  3273. my $lastcommit = $self->_get_prop("last_commit");
  3274. if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
  3275. # invalidate the gethead cache
  3276. $self->clearCommitRefCaches();
  3277. return 1;
  3278. }
  3279. # Start exclusive lock here...
  3280. $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
  3281. # TODO: log processing is memory bound
  3282. # if we can parse into a 2nd file that is in reverse order
  3283. # we can probably do something really efficient
  3284. my @git_log_params = ('--pretty', '--parents', '--topo-order');
  3285. if (defined $lastcommit) {
  3286. push @git_log_params, "$lastcommit..$self->{module}";
  3287. } else {
  3288. push @git_log_params, $self->{module};
  3289. }
  3290. # git-rev-list is the backend / plumbing version of git-log
  3291. open(my $gitLogPipe, '-|', 'git', 'rev-list', @git_log_params)
  3292. or die "Cannot call git-rev-list: $!";
  3293. my @commits=readCommits($gitLogPipe);
  3294. close $gitLogPipe;
  3295. # Now all the commits are in the @commits bucket
  3296. # ordered by time DESC. for each commit that needs processing,
  3297. # determine whether it's following the last head we've seen or if
  3298. # it's on its own branch, grab a file list, and add whatever's changed
  3299. # NOTE: $lastcommit refers to the last commit from previous run
  3300. # $lastpicked is the last commit we picked in this run
  3301. my $lastpicked;
  3302. my $head = {};
  3303. if (defined $lastcommit) {
  3304. $lastpicked = $lastcommit;
  3305. }
  3306. my $committotal = scalar(@commits);
  3307. my $commitcount = 0;
  3308. # Load the head table into $head (for cached lookups during the update process)
  3309. foreach my $file ( @{$self->gethead(1)} )
  3310. {
  3311. $head->{$file->{name}} = $file;
  3312. }
  3313. foreach my $commit ( @commits )
  3314. {
  3315. $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
  3316. if (defined $lastpicked)
  3317. {
  3318. if (!in_array($lastpicked, @{$commit->{parents}}))
  3319. {
  3320. # skip, we'll see this delta
  3321. # as part of a merge later
  3322. # warn "skipping off-track $commit->{hash}\n";
  3323. next;
  3324. } elsif (@{$commit->{parents}} > 1) {
  3325. # it is a merge commit, for each parent that is
  3326. # not $lastpicked (not given a CVS revision number),
  3327. # see if we can get a log
  3328. # from the merge-base to that parent to put it
  3329. # in the message as a merge summary.
  3330. my @parents = @{$commit->{parents}};
  3331. foreach my $parent (@parents) {
  3332. if ($parent eq $lastpicked) {
  3333. next;
  3334. }
  3335. # git-merge-base can potentially (but rarely) throw
  3336. # several candidate merge bases. let's assume
  3337. # that the first one is the best one.
  3338. my $base = eval {
  3339. ::safe_pipe_capture('git', 'merge-base',
  3340. $lastpicked, $parent);
  3341. };
  3342. # The two branches may not be related at all,
  3343. # in which case merge base simply fails to find
  3344. # any, but that's Ok.
  3345. next if ($@);
  3346. chomp $base;
  3347. if ($base) {
  3348. my @merged;
  3349. # print "want to log between $base $parent \n";
  3350. open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
  3351. or die "Cannot call git-log: $!";
  3352. my $mergedhash;
  3353. while (<GITLOG>) {
  3354. chomp;
  3355. if (!defined $mergedhash) {
  3356. if (m/^commit\s+(.+)$/) {
  3357. $mergedhash = $1;
  3358. } else {
  3359. next;
  3360. }
  3361. } else {
  3362. # grab the first line that looks non-rfc822
  3363. # aka has content after leading space
  3364. if (m/^\s+(\S.*)$/) {
  3365. my $title = $1;
  3366. $title = substr($title,0,100); # truncate
  3367. unshift @merged, "$mergedhash $title";
  3368. undef $mergedhash;
  3369. }
  3370. }
  3371. }
  3372. close GITLOG;
  3373. if (@merged) {
  3374. $commit->{mergemsg} = $commit->{message};
  3375. $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
  3376. foreach my $summary (@merged) {
  3377. $commit->{mergemsg} .= "\t$summary\n";
  3378. }
  3379. $commit->{mergemsg} .= "\n\n";
  3380. # print "Message for $commit->{hash} \n$commit->{mergemsg}";
  3381. }
  3382. }
  3383. }
  3384. }
  3385. }
  3386. # convert the date to CVS-happy format
  3387. my $cvsDate = convertToCvsDate($commit->{date});
  3388. if ( defined ( $lastpicked ) )
  3389. {
  3390. my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
  3391. local ($/) = "\0";
  3392. while ( <FILELIST> )
  3393. {
  3394. chomp;
  3395. unless ( /^:\d{6}\s+([0-7]{6})\s+[a-f0-9]{40}\s+([a-f0-9]{40})\s+(\w)$/o )
  3396. {
  3397. die("Couldn't process git-diff-tree line : $_");
  3398. }
  3399. my ($mode, $hash, $change) = ($1, $2, $3);
  3400. my $name = <FILELIST>;
  3401. chomp($name);
  3402. # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
  3403. my $dbMode = convertToDbMode($mode);
  3404. if ( $change eq "D" )
  3405. {
  3406. #$log->debug("DELETE $name");
  3407. $head->{$name} = {
  3408. name => $name,
  3409. revision => $head->{$name}{revision} + 1,
  3410. filehash => "deleted",
  3411. commithash => $commit->{hash},
  3412. modified => $cvsDate,
  3413. author => $commit->{author},
  3414. mode => $dbMode,
  3415. };
  3416. $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
  3417. }
  3418. elsif ( $change eq "M" || $change eq "T" )
  3419. {
  3420. #$log->debug("MODIFIED $name");
  3421. $head->{$name} = {
  3422. name => $name,
  3423. revision => $head->{$name}{revision} + 1,
  3424. filehash => $hash,
  3425. commithash => $commit->{hash},
  3426. modified => $cvsDate,
  3427. author => $commit->{author},
  3428. mode => $dbMode,
  3429. };
  3430. $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
  3431. }
  3432. elsif ( $change eq "A" )
  3433. {
  3434. #$log->debug("ADDED $name");
  3435. $head->{$name} = {
  3436. name => $name,
  3437. revision => $head->{$name}{revision} ? $head->{$name}{revision}+1 : 1,
  3438. filehash => $hash,
  3439. commithash => $commit->{hash},
  3440. modified => $cvsDate,
  3441. author => $commit->{author},
  3442. mode => $dbMode,
  3443. };
  3444. $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
  3445. }
  3446. else
  3447. {
  3448. $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
  3449. die;
  3450. }
  3451. }
  3452. close FILELIST;
  3453. } else {
  3454. # this is used to detect files removed from the repo
  3455. my $seen_files = {};
  3456. my $filepipe = open(FILELIST, '-|', 'git', 'ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
  3457. local $/ = "\0";
  3458. while ( <FILELIST> )
  3459. {
  3460. chomp;
  3461. unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
  3462. {
  3463. die("Couldn't process git-ls-tree line : $_");
  3464. }
  3465. my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
  3466. $seen_files->{$git_filename} = 1;
  3467. my ( $oldhash, $oldrevision, $oldmode ) = (
  3468. $head->{$git_filename}{filehash},
  3469. $head->{$git_filename}{revision},
  3470. $head->{$git_filename}{mode}
  3471. );
  3472. my $dbMode = convertToDbMode($mode);
  3473. # unless the file exists with the same hash, we need to update it ...
  3474. unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $dbMode )
  3475. {
  3476. my $newrevision = ( $oldrevision or 0 ) + 1;
  3477. $head->{$git_filename} = {
  3478. name => $git_filename,
  3479. revision => $newrevision,
  3480. filehash => $git_hash,
  3481. commithash => $commit->{hash},
  3482. modified => $cvsDate,
  3483. author => $commit->{author},
  3484. mode => $dbMode,
  3485. };
  3486. $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
  3487. }
  3488. }
  3489. close FILELIST;
  3490. # Detect deleted files
  3491. foreach my $file ( sort keys %$head )
  3492. {
  3493. unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
  3494. {
  3495. $head->{$file}{revision}++;
  3496. $head->{$file}{filehash} = "deleted";
  3497. $head->{$file}{commithash} = $commit->{hash};
  3498. $head->{$file}{modified} = $cvsDate;
  3499. $head->{$file}{author} = $commit->{author};
  3500. $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $cvsDate, $commit->{author}, $head->{$file}{mode});
  3501. }
  3502. }
  3503. # END : "Detect deleted files"
  3504. }
  3505. if (exists $commit->{mergemsg})
  3506. {
  3507. $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
  3508. }
  3509. $lastpicked = $commit->{hash};
  3510. $self->_set_prop("last_commit", $commit->{hash});
  3511. }
  3512. $self->delete_head();
  3513. foreach my $file ( sort keys %$head )
  3514. {
  3515. $self->insert_head(
  3516. $file,
  3517. $head->{$file}{revision},
  3518. $head->{$file}{filehash},
  3519. $head->{$file}{commithash},
  3520. $head->{$file}{modified},
  3521. $head->{$file}{author},
  3522. $head->{$file}{mode},
  3523. );
  3524. }
  3525. # invalidate the gethead cache
  3526. $self->clearCommitRefCaches();
  3527. # Ending exclusive lock here
  3528. $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
  3529. }
  3530. sub readCommits
  3531. {
  3532. my $pipeHandle = shift;
  3533. my @commits;
  3534. my %commit = ();
  3535. while ( <$pipeHandle> )
  3536. {
  3537. chomp;
  3538. if (m/^commit\s+(.*)$/) {
  3539. # on ^commit lines put the just seen commit in the stack
  3540. # and prime things for the next one
  3541. if (keys %commit) {
  3542. my %copy = %commit;
  3543. unshift @commits, \%copy;
  3544. %commit = ();
  3545. }
  3546. my @parents = split(m/\s+/, $1);
  3547. $commit{hash} = shift @parents;
  3548. $commit{parents} = \@parents;
  3549. } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
  3550. # on rfc822-like lines seen before we see any message,
  3551. # lowercase the entry and put it in the hash as key-value
  3552. $commit{lc($1)} = $2;
  3553. } else {
  3554. # message lines - skip initial empty line
  3555. # and trim whitespace
  3556. if (!exists($commit{message}) && m/^\s*$/) {
  3557. # define it to mark the end of headers
  3558. $commit{message} = '';
  3559. next;
  3560. }
  3561. s/^\s+//; s/\s+$//; # trim ws
  3562. $commit{message} .= $_ . "\n";
  3563. }
  3564. }
  3565. unshift @commits, \%commit if ( keys %commit );
  3566. return @commits;
  3567. }
  3568. sub convertToCvsDate
  3569. {
  3570. my $date = shift;
  3571. # Convert from: "git rev-list --pretty" formatted date
  3572. # Convert to: "the format specified by RFC822 as modified by RFC1123."
  3573. # Example: 26 May 1997 13:01:40 -0400
  3574. if( $date =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ )
  3575. {
  3576. $date = "$2 $1 $4 $3 $5";
  3577. }
  3578. return $date;
  3579. }
  3580. sub convertToDbMode
  3581. {
  3582. my $mode = shift;
  3583. # NOTE: The CVS protocol uses a string similar "u=rw,g=rw,o=rw",
  3584. # but the database "mode" column historically (and currently)
  3585. # only stores the "rw" (for user) part of the string.
  3586. # FUTURE: It might make more sense to persist the raw
  3587. # octal mode (or perhaps the final full CVS form) instead of
  3588. # this half-converted form, but it isn't currently worth the
  3589. # backwards compatibility headaches.
  3590. $mode=~/^\d{3}(\d)\d\d$/;
  3591. my $userBits=$1;
  3592. my $dbMode = "";
  3593. $dbMode .= "r" if ( $userBits & 4 );
  3594. $dbMode .= "w" if ( $userBits & 2 );
  3595. $dbMode .= "x" if ( $userBits & 1 );
  3596. $dbMode = "rw" if ( $dbMode eq "" );
  3597. return $dbMode;
  3598. }
  3599. sub insert_rev
  3600. {
  3601. my $self = shift;
  3602. my $name = shift;
  3603. my $revision = shift;
  3604. my $filehash = shift;
  3605. my $commithash = shift;
  3606. my $modified = shift;
  3607. my $author = shift;
  3608. my $mode = shift;
  3609. my $tablename = $self->tablename("revision");
  3610. my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
  3611. $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
  3612. }
  3613. sub insert_mergelog
  3614. {
  3615. my $self = shift;
  3616. my $key = shift;
  3617. my $value = shift;
  3618. my $tablename = $self->tablename("commitmsgs");
  3619. my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
  3620. $insert_mergelog->execute($key, $value);
  3621. }
  3622. sub delete_head
  3623. {
  3624. my $self = shift;
  3625. my $tablename = $self->tablename("head");
  3626. my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM $tablename",{},1);
  3627. $delete_head->execute();
  3628. }
  3629. sub insert_head
  3630. {
  3631. my $self = shift;
  3632. my $name = shift;
  3633. my $revision = shift;
  3634. my $filehash = shift;
  3635. my $commithash = shift;
  3636. my $modified = shift;
  3637. my $author = shift;
  3638. my $mode = shift;
  3639. my $tablename = $self->tablename("head");
  3640. my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
  3641. $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
  3642. }
  3643. sub _get_prop
  3644. {
  3645. my $self = shift;
  3646. my $key = shift;
  3647. my $tablename = $self->tablename("properties");
  3648. my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
  3649. $db_query->execute($key);
  3650. my ( $value ) = $db_query->fetchrow_array;
  3651. return $value;
  3652. }
  3653. sub _set_prop
  3654. {
  3655. my $self = shift;
  3656. my $key = shift;
  3657. my $value = shift;
  3658. my $tablename = $self->tablename("properties");
  3659. my $db_query = $self->{dbh}->prepare_cached("UPDATE $tablename SET value=? WHERE key=?",{},1);
  3660. $db_query->execute($value, $key);
  3661. unless ( $db_query->rows )
  3662. {
  3663. $db_query = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
  3664. $db_query->execute($key, $value);
  3665. }
  3666. return $value;
  3667. }
  3668. =head2 gethead
  3669. =cut
  3670. sub gethead
  3671. {
  3672. my $self = shift;
  3673. my $intRev = shift;
  3674. my $tablename = $self->tablename("head");
  3675. return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
  3676. my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM $tablename ORDER BY name ASC",{},1);
  3677. $db_query->execute();
  3678. my $tree = [];
  3679. while ( my $file = $db_query->fetchrow_hashref )
  3680. {
  3681. if(!$intRev)
  3682. {
  3683. $file->{revision} = "1.$file->{revision}"
  3684. }
  3685. push @$tree, $file;
  3686. }
  3687. $self->{gethead_cache} = $tree;
  3688. return $tree;
  3689. }
  3690. =head2 getAnyHead
  3691. Returns a reference to an array of getmeta structures, one
  3692. per file in the specified tree hash.
  3693. =cut
  3694. sub getAnyHead
  3695. {
  3696. my ($self,$hash) = @_;
  3697. if(!defined($hash))
  3698. {
  3699. return $self->gethead();
  3700. }
  3701. my @files;
  3702. {
  3703. open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
  3704. or die("Cannot call git-ls-tree : $!");
  3705. local $/ = "\0";
  3706. @files=<$filePipe>;
  3707. close $filePipe;
  3708. }
  3709. my $tree=[];
  3710. my($line);
  3711. foreach $line (@files)
  3712. {
  3713. $line=~s/\0$//;
  3714. unless ( $line=~/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
  3715. {
  3716. die("Couldn't process git-ls-tree line : $_");
  3717. }
  3718. my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
  3719. push @$tree, $self->getMetaFromCommithash($git_filename,$hash);
  3720. }
  3721. return $tree;
  3722. }
  3723. =head2 getRevisionDirMap
  3724. A "revision dir map" contains all the plain-file filenames associated
  3725. with a particular revision (tree-ish), organized by directory:
  3726. $type = $out->{$dir}{$fullName}
  3727. The type of each is "F" (for ordinary file) or "D" (for directory,
  3728. for which the map $out->{$fullName} will also exist).
  3729. =cut
  3730. sub getRevisionDirMap
  3731. {
  3732. my ($self,$ver)=@_;
  3733. if(!defined($self->{revisionDirMapCache}))
  3734. {
  3735. $self->{revisionDirMapCache}={};
  3736. }
  3737. # Get file list (previously cached results are dependent on HEAD,
  3738. # but are early in each case):
  3739. my $cacheKey;
  3740. my (@fileList);
  3741. if( !defined($ver) || $ver eq "" )
  3742. {
  3743. $cacheKey="";
  3744. if( defined($self->{revisionDirMapCache}{$cacheKey}) )
  3745. {
  3746. return $self->{revisionDirMapCache}{$cacheKey};
  3747. }
  3748. my @head = @{$self->gethead()};
  3749. foreach my $file ( @head )
  3750. {
  3751. next if ( $file->{filehash} eq "deleted" );
  3752. push @fileList,$file->{name};
  3753. }
  3754. }
  3755. else
  3756. {
  3757. my ($hash)=$self->lookupCommitRef($ver);
  3758. if( !defined($hash) )
  3759. {
  3760. return undef;
  3761. }
  3762. $cacheKey=$hash;
  3763. if( defined($self->{revisionDirMapCache}{$cacheKey}) )
  3764. {
  3765. return $self->{revisionDirMapCache}{$cacheKey};
  3766. }
  3767. open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
  3768. or die("Cannot call git-ls-tree : $!");
  3769. local $/ = "\0";
  3770. while ( <$filePipe> )
  3771. {
  3772. chomp;
  3773. unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
  3774. {
  3775. die("Couldn't process git-ls-tree line : $_");
  3776. }
  3777. my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
  3778. push @fileList, $git_filename;
  3779. }
  3780. close $filePipe;
  3781. }
  3782. # Convert to normalized form:
  3783. my %revMap;
  3784. my $file;
  3785. foreach $file (@fileList)
  3786. {
  3787. my($dir) = ($file=~m%^(?:(.*)/)?([^/]*)$%);
  3788. $dir='' if(!defined($dir));
  3789. # parent directories:
  3790. # ... create empty dir maps for parent dirs:
  3791. my($td)=$dir;
  3792. while(!defined($revMap{$td}))
  3793. {
  3794. $revMap{$td}={};
  3795. my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
  3796. $tp='' if(!defined($tp));
  3797. $td=$tp;
  3798. }
  3799. # ... add children to parent maps (now that they exist):
  3800. $td=$dir;
  3801. while($td ne "")
  3802. {
  3803. my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
  3804. $tp='' if(!defined($tp));
  3805. if(defined($revMap{$tp}{$td}))
  3806. {
  3807. if($revMap{$tp}{$td} ne 'D')
  3808. {
  3809. die "Weird file/directory inconsistency in $cacheKey";
  3810. }
  3811. last; # loop exit
  3812. }
  3813. $revMap{$tp}{$td}='D';
  3814. $td=$tp;
  3815. }
  3816. # file
  3817. $revMap{$dir}{$file}='F';
  3818. }
  3819. # Save in cache:
  3820. $self->{revisionDirMapCache}{$cacheKey}=\%revMap;
  3821. return $self->{revisionDirMapCache}{$cacheKey};
  3822. }
  3823. =head2 getlog
  3824. See also gethistorydense().
  3825. =cut
  3826. sub getlog
  3827. {
  3828. my $self = shift;
  3829. my $filename = shift;
  3830. my $revFilter = shift;
  3831. my $tablename = $self->tablename("revision");
  3832. # Filters:
  3833. # TODO: date, state, or by specific logins filters?
  3834. # TODO: Handle comma-separated list of revFilter items, each item
  3835. # can be a range [only case currently handled] or individual
  3836. # rev or branch or "branch.".
  3837. # TODO: Adjust $db_query WHERE clause based on revFilter, instead of
  3838. # manually filtering the results of the query?
  3839. my ( $minrev, $maxrev );
  3840. if( defined($revFilter) and
  3841. $state->{opt}{r} =~ /^(1.(\d+))?(::?)(1.(\d.+))?$/ )
  3842. {
  3843. my $control = $3;
  3844. $minrev = $2;
  3845. $maxrev = $5;
  3846. $minrev++ if ( defined($minrev) and $control eq "::" );
  3847. }
  3848. my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM $tablename WHERE name=? ORDER BY revision DESC",{},1);
  3849. $db_query->execute($filename);
  3850. my $totalRevs=0;
  3851. my $tree = [];
  3852. while ( my $file = $db_query->fetchrow_hashref )
  3853. {
  3854. $totalRevs++;
  3855. if( defined($minrev) and $file->{revision} < $minrev )
  3856. {
  3857. next;
  3858. }
  3859. if( defined($maxrev) and $file->{revision} > $maxrev )
  3860. {
  3861. next;
  3862. }
  3863. $file->{revision} = "1." . $file->{revision};
  3864. push @$tree, $file;
  3865. }
  3866. return ($tree,$totalRevs);
  3867. }
  3868. =head2 getmeta
  3869. This function takes a filename (with path) argument and returns a hashref of
  3870. metadata for that file.
  3871. There are several ways $revision can be specified:
  3872. - A reference to hash that contains a "tag" that is the
  3873. actual revision (one of the below). TODO: Also allow it to
  3874. specify a "date" in the hash.
  3875. - undef, to refer to the latest version on the main branch.
  3876. - Full CVS client revision number (mapped to integer in DB, without the
  3877. "1." prefix),
  3878. - Complex CVS-compatible "special" revision number for
  3879. non-linear history (see comment below)
  3880. - git commit sha1 hash
  3881. - branch or tag name
  3882. =cut
  3883. sub getmeta
  3884. {
  3885. my $self = shift;
  3886. my $filename = shift;
  3887. my $revision = shift;
  3888. my $tablename_rev = $self->tablename("revision");
  3889. my $tablename_head = $self->tablename("head");
  3890. if ( ref($revision) eq "HASH" )
  3891. {
  3892. $revision = $revision->{tag};
  3893. }
  3894. # Overview of CVS revision numbers:
  3895. #
  3896. # General CVS numbering scheme:
  3897. # - Basic mainline branch numbers: "1.1", "1.2", "1.3", etc.
  3898. # - Result of "cvs checkin -r" (possible, but not really
  3899. # recommended): "2.1", "2.2", etc
  3900. # - Branch tag: "1.2.0.n", where "1.2" is revision it was branched
  3901. # from, "0" is a magic placeholder that identifies it as a
  3902. # branch tag instead of a version tag, and n is 2 times the
  3903. # branch number off of "1.2", starting with "2".
  3904. # - Version on a branch: "1.2.n.x", where "1.2" is branch-from, "n"
  3905. # is branch number off of "1.2" (like n above), and "x" is
  3906. # the version number on the branch.
  3907. # - Branches can branch off of branches: "1.3.2.7.4.1" (even number
  3908. # of components).
  3909. # - Odd "n"s are used by "vendor branches" that result
  3910. # from "cvs import". Vendor branches have additional
  3911. # strangeness in the sense that the main rcs "head" of the main
  3912. # branch will (temporarily until first normal commit) point
  3913. # to the version on the vendor branch, rather than the actual
  3914. # main branch. (FUTURE: This may provide an opportunity
  3915. # to use "strange" revision numbers for fast-forward-merged
  3916. # branch tip when CVS client is asking for the main branch.)
  3917. #
  3918. # git-cvsserver CVS-compatible special numbering schemes:
  3919. # - Currently git-cvsserver only tries to be identical to CVS for
  3920. # simple "1.x" numbers on the "main" branch (as identified
  3921. # by the module name that was originally cvs checkout'ed).
  3922. # - The database only stores the "x" part, for historical reasons.
  3923. # But most of the rest of the cvsserver preserves
  3924. # and thinks using the full revision number.
  3925. # - To handle non-linear history, it uses a version of the form
  3926. # "2.1.1.2000.b.b.b."..., where the 2.1.1.2000 is to help uniquely
  3927. # identify this as a special revision number, and there are
  3928. # 20 b's that together encode the sha1 git commit from which
  3929. # this version of this file originated. Each b is
  3930. # the numerical value of the corresponding byte plus
  3931. # 100.
  3932. # - "plus 100" avoids "0"s, and also reduces the
  3933. # likelihood of a collision in the case that someone someday
  3934. # writes an import tool that tries to preserve original
  3935. # CVS revision numbers, and the original CVS data had done
  3936. # lots of branches off of branches and other strangeness to
  3937. # end up with a real version number that just happens to look
  3938. # like this special revision number form. Also, if needed
  3939. # there are several ways to extend/identify alternative encodings
  3940. # within the "2.1.1.2000" part if necessary.
  3941. # - Unlike real CVS revisions, you can't really reconstruct what
  3942. # relation a revision of this form has to other revisions.
  3943. # - FUTURE: TODO: Rework database somehow to make up and remember
  3944. # fully-CVS-compatible branches and branch version numbers.
  3945. my $meta;
  3946. if ( defined($revision) )
  3947. {
  3948. if ( $revision =~ /^1\.(\d+)$/ )
  3949. {
  3950. my ($intRev) = $1;
  3951. my $db_query;
  3952. $db_query = $self->{dbh}->prepare_cached(
  3953. "SELECT * FROM $tablename_rev WHERE name=? AND revision=?",
  3954. {},1);
  3955. $db_query->execute($filename, $intRev);
  3956. $meta = $db_query->fetchrow_hashref;
  3957. }
  3958. elsif ( $revision =~ /^2\.1\.1\.2000(\.[1-3][0-9][0-9]){20}$/ )
  3959. {
  3960. my ($commitHash)=($revision=~/^2\.1\.1\.2000(.*)$/);
  3961. $commitHash=~s/\.([0-9]+)/sprintf("%02x",$1-100)/eg;
  3962. if($commitHash=~/^[0-9a-f]{40}$/)
  3963. {
  3964. return $self->getMetaFromCommithash($filename,$commitHash);
  3965. }
  3966. # error recovery: fall back on head version below
  3967. print "E Failed to find $filename version=$revision or commit=$commitHash\n";
  3968. $log->warning("failed get $revision with commithash=$commitHash");
  3969. undef $revision;
  3970. }
  3971. elsif ( $revision =~ /^[0-9a-f]{40}$/ )
  3972. {
  3973. # Try DB first. This is mostly only useful for req_annotate(),
  3974. # which only calls this for stuff that should already be in
  3975. # the DB. It is fairly likely to be a waste of time
  3976. # in most other cases [unless the file happened to be
  3977. # modified in $revision specifically], but
  3978. # it is probably in the noise compared to how long
  3979. # getMetaFromCommithash() will take.
  3980. my $db_query;
  3981. $db_query = $self->{dbh}->prepare_cached(
  3982. "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
  3983. {},1);
  3984. $db_query->execute($filename, $revision);
  3985. $meta = $db_query->fetchrow_hashref;
  3986. if(! $meta)
  3987. {
  3988. my($revCommit)=$self->lookupCommitRef($revision);
  3989. if($revCommit=~/^[0-9a-f]{40}$/)
  3990. {
  3991. return $self->getMetaFromCommithash($filename,$revCommit);
  3992. }
  3993. # error recovery: nothing found:
  3994. print "E Failed to find $filename version=$revision\n";
  3995. $log->warning("failed get $revision");
  3996. return $meta;
  3997. }
  3998. }
  3999. else
  4000. {
  4001. my($revCommit)=$self->lookupCommitRef($revision);
  4002. if($revCommit=~/^[0-9a-f]{40}$/)
  4003. {
  4004. return $self->getMetaFromCommithash($filename,$revCommit);
  4005. }
  4006. # error recovery: fall back on head version below
  4007. print "E Failed to find $filename version=$revision\n";
  4008. $log->warning("failed get $revision");
  4009. undef $revision; # Allow fallback
  4010. }
  4011. }
  4012. if(!defined($revision))
  4013. {
  4014. my $db_query;
  4015. $db_query = $self->{dbh}->prepare_cached(
  4016. "SELECT * FROM $tablename_head WHERE name=?",{},1);
  4017. $db_query->execute($filename);
  4018. $meta = $db_query->fetchrow_hashref;
  4019. }
  4020. if($meta)
  4021. {
  4022. $meta->{revision} = "1.$meta->{revision}";
  4023. }
  4024. return $meta;
  4025. }
  4026. sub getMetaFromCommithash
  4027. {
  4028. my $self = shift;
  4029. my $filename = shift;
  4030. my $revCommit = shift;
  4031. # NOTE: This function doesn't scale well (lots of forks), especially
  4032. # if you have many files that have not been modified for many commits
  4033. # (each git-rev-parse redoes a lot of work for each file
  4034. # that theoretically could be done in parallel by smarter
  4035. # graph traversal).
  4036. #
  4037. # TODO: Possible optimization strategies:
  4038. # - Solve the issue of assigning and remembering "real" CVS
  4039. # revision numbers for branches, and ensure the
  4040. # data structure can do this efficiently. Perhaps something
  4041. # similar to "git notes", and carefully structured to take
  4042. # advantage same-sha1-is-same-contents, to roll the same
  4043. # unmodified subdirectory data onto multiple commits?
  4044. # - Write and use a C tool that is like git-blame, but
  4045. # operates on multiple files with file granularity, instead
  4046. # of one file with line granularity. Cache
  4047. # most-recently-modified in $self->{commitRefCache}{$revCommit}.
  4048. # Try to be intelligent about how many files we do with
  4049. # one fork (perhaps one directory at a time, without recursion,
  4050. # and/or include directory as one line item, recurse from here
  4051. # instead of in C tool?).
  4052. # - Perhaps we could ask the DB for (filename,fileHash),
  4053. # and just guess that it is correct (that the file hadn't
  4054. # changed between $revCommit and the found commit, then
  4055. # changed back, confusing anything trying to interpret
  4056. # history). Probably need to add another index to revisions
  4057. # DB table for this.
  4058. # - NOTE: Trying to store all (commit,file) keys in DB [to
  4059. # find "lastModfiedCommit] (instead of
  4060. # just files that changed in each commit as we do now) is
  4061. # probably not practical from a disk space perspective.
  4062. # Does the file exist in $revCommit?
  4063. # TODO: Include file hash in dirmap cache.
  4064. my($dirMap)=$self->getRevisionDirMap($revCommit);
  4065. my($dir,$file)=($filename=~m%^(?:(.*)/)?([^/]*$)%);
  4066. if(!defined($dir))
  4067. {
  4068. $dir="";
  4069. }
  4070. if( !defined($dirMap->{$dir}) ||
  4071. !defined($dirMap->{$dir}{$filename}) )
  4072. {
  4073. my($fileHash)="deleted";
  4074. my($retVal)={};
  4075. $retVal->{name}=$filename;
  4076. $retVal->{filehash}=$fileHash;
  4077. # not needed and difficult to compute:
  4078. $retVal->{revision}="0"; # $revision;
  4079. $retVal->{commithash}=$revCommit;
  4080. #$retVal->{author}=$commit->{author};
  4081. #$retVal->{modified}=convertToCvsDate($commit->{date});
  4082. #$retVal->{mode}=convertToDbMode($mode);
  4083. return $retVal;
  4084. }
  4085. my($fileHash) = ::safe_pipe_capture("git","rev-parse","$revCommit:$filename");
  4086. chomp $fileHash;
  4087. if(!($fileHash=~/^[0-9a-f]{40}$/))
  4088. {
  4089. die "Invalid fileHash '$fileHash' looking up"
  4090. ." '$revCommit:$filename'\n";
  4091. }
  4092. # information about most recent commit to modify $filename:
  4093. open(my $gitLogPipe, '-|', 'git', 'rev-list',
  4094. '--max-count=1', '--pretty', '--parents',
  4095. $revCommit, '--', $filename)
  4096. or die "Cannot call git-rev-list: $!";
  4097. my @commits=readCommits($gitLogPipe);
  4098. close $gitLogPipe;
  4099. if(scalar(@commits)!=1)
  4100. {
  4101. die "Can't find most recent commit changing $filename\n";
  4102. }
  4103. my($commit)=$commits[0];
  4104. if( !defined($commit) || !defined($commit->{hash}) )
  4105. {
  4106. return undef;
  4107. }
  4108. # does this (commit,file) have a real assigned CVS revision number?
  4109. my $tablename_rev = $self->tablename("revision");
  4110. my $db_query;
  4111. $db_query = $self->{dbh}->prepare_cached(
  4112. "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
  4113. {},1);
  4114. $db_query->execute($filename, $commit->{hash});
  4115. my($meta)=$db_query->fetchrow_hashref;
  4116. if($meta)
  4117. {
  4118. $meta->{revision} = "1.$meta->{revision}";
  4119. return $meta;
  4120. }
  4121. # fall back on special revision number
  4122. my($revision)=$commit->{hash};
  4123. $revision=~s/(..)/'.' . (hex($1)+100)/eg;
  4124. $revision="2.1.1.2000$revision";
  4125. # meta data about $filename:
  4126. open(my $filePipe, '-|', 'git', 'ls-tree', '-z',
  4127. $commit->{hash}, '--', $filename)
  4128. or die("Cannot call git-ls-tree : $!");
  4129. local $/ = "\0";
  4130. my $line;
  4131. $line=<$filePipe>;
  4132. if(defined(<$filePipe>))
  4133. {
  4134. die "Expected only a single file for git-ls-tree $filename\n";
  4135. }
  4136. close $filePipe;
  4137. chomp $line;
  4138. unless ( $line=~m/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
  4139. {
  4140. die("Couldn't process git-ls-tree line : $line\n");
  4141. }
  4142. my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
  4143. # save result:
  4144. my($retVal)={};
  4145. $retVal->{name}=$filename;
  4146. $retVal->{revision}=$revision;
  4147. $retVal->{filehash}=$fileHash;
  4148. $retVal->{commithash}=$revCommit;
  4149. $retVal->{author}=$commit->{author};
  4150. $retVal->{modified}=convertToCvsDate($commit->{date});
  4151. $retVal->{mode}=convertToDbMode($mode);
  4152. return $retVal;
  4153. }
  4154. =head2 lookupCommitRef
  4155. Convert tag/branch/abbreviation/etc into a commit sha1 hash. Caches
  4156. the result so looking it up again is fast.
  4157. =cut
  4158. sub lookupCommitRef
  4159. {
  4160. my $self = shift;
  4161. my $ref = shift;
  4162. my $commitHash = $self->{commitRefCache}{$ref};
  4163. if(defined($commitHash))
  4164. {
  4165. return $commitHash;
  4166. }
  4167. $commitHash = ::safe_pipe_capture("git","rev-parse","--verify","--quiet",
  4168. $self->unescapeRefName($ref));
  4169. $commitHash=~s/\s*$//;
  4170. if(!($commitHash=~/^[0-9a-f]{40}$/))
  4171. {
  4172. $commitHash=undef;
  4173. }
  4174. if( defined($commitHash) )
  4175. {
  4176. my $type = ::safe_pipe_capture("git","cat-file","-t",$commitHash);
  4177. if( ! ($type=~/^commit\s*$/ ) )
  4178. {
  4179. $commitHash=undef;
  4180. }
  4181. }
  4182. if(defined($commitHash))
  4183. {
  4184. $self->{commitRefCache}{$ref}=$commitHash;
  4185. }
  4186. return $commitHash;
  4187. }
  4188. =head2 clearCommitRefCaches
  4189. Clears cached commit cache (sha1's for various tags/abbeviations/etc),
  4190. and related caches.
  4191. =cut
  4192. sub clearCommitRefCaches
  4193. {
  4194. my $self = shift;
  4195. $self->{commitRefCache} = {};
  4196. $self->{revisionDirMapCache} = undef;
  4197. $self->{gethead_cache} = undef;
  4198. }
  4199. =head2 commitmessage
  4200. this function takes a commithash and returns the commit message for that commit
  4201. =cut
  4202. sub commitmessage
  4203. {
  4204. my $self = shift;
  4205. my $commithash = shift;
  4206. my $tablename = $self->tablename("commitmsgs");
  4207. die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
  4208. my $db_query;
  4209. $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
  4210. $db_query->execute($commithash);
  4211. my ( $message ) = $db_query->fetchrow_array;
  4212. if ( defined ( $message ) )
  4213. {
  4214. $message .= " " if ( $message =~ /\n$/ );
  4215. return $message;
  4216. }
  4217. my @lines = ::safe_pipe_capture("git", "cat-file", "commit", $commithash);
  4218. shift @lines while ( $lines[0] =~ /\S/ );
  4219. $message = join("",@lines);
  4220. $message .= " " if ( $message =~ /\n$/ );
  4221. return $message;
  4222. }
  4223. =head2 gethistorydense
  4224. This function takes a filename (with path) argument and returns an arrayofarrays
  4225. containing revision,filehash,commithash ordered by revision descending.
  4226. This version of gethistory skips deleted entries -- so it is useful for annotate.
  4227. The 'dense' part is a reference to a '--dense' option available for git-rev-list
  4228. and other git tools that depend on it.
  4229. See also getlog().
  4230. =cut
  4231. sub gethistorydense
  4232. {
  4233. my $self = shift;
  4234. my $filename = shift;
  4235. my $tablename = $self->tablename("revision");
  4236. my $db_query;
  4237. $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM $tablename WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
  4238. $db_query->execute($filename);
  4239. my $result = $db_query->fetchall_arrayref;
  4240. my $i;
  4241. for($i=0 ; $i<scalar(@$result) ; $i++)
  4242. {
  4243. $result->[$i][0]="1." . $result->[$i][0];
  4244. }
  4245. return $result;
  4246. }
  4247. =head2 escapeRefName
  4248. Apply an escape mechanism to compensate for characters that
  4249. git ref names can have that CVS tags can not.
  4250. =cut
  4251. sub escapeRefName
  4252. {
  4253. my($self,$refName)=@_;
  4254. # CVS officially only allows [-_A-Za-z0-9] in tag names (or in
  4255. # many contexts it can also be a CVS revision number).
  4256. #
  4257. # Git tags commonly use '/' and '.' as well, but also handle
  4258. # anything else just in case:
  4259. #
  4260. # = "_-s-" For '/'.
  4261. # = "_-p-" For '.'.
  4262. # = "_-u-" For underscore, in case someone wants a literal "_-" in
  4263. # a tag name.
  4264. # = "_-xx-" Where "xx" is the hexadecimal representation of the
  4265. # desired ASCII character byte. (for anything else)
  4266. if(! $refName=~/^[1-9][0-9]*(\.[1-9][0-9]*)*$/)
  4267. {
  4268. $refName=~s/_-/_-u--/g;
  4269. $refName=~s/\./_-p-/g;
  4270. $refName=~s%/%_-s-%g;
  4271. $refName=~s/[^-_a-zA-Z0-9]/sprintf("_-%02x-",$1)/eg;
  4272. }
  4273. }
  4274. =head2 unescapeRefName
  4275. Undo an escape mechanism to compensate for characters that
  4276. git ref names can have that CVS tags can not.
  4277. =cut
  4278. sub unescapeRefName
  4279. {
  4280. my($self,$refName)=@_;
  4281. # see escapeRefName() for description of escape mechanism.
  4282. $refName=~s/_-([spu]|[0-9a-f][0-9a-f])-/unescapeRefNameChar($1)/eg;
  4283. # allowed tag names
  4284. # TODO: Perhaps use git check-ref-format, with an in-process cache of
  4285. # validated names?
  4286. if( !( $refName=~m%^[^-][-a-zA-Z0-9_/.]*$% ) ||
  4287. ( $refName=~m%[/.]$% ) ||
  4288. ( $refName=~/\.lock$/ ) ||
  4289. ( $refName=~m%\.\.|/\.|[[\\:?*~]|\@\{% ) ) # matching }
  4290. {
  4291. # Error:
  4292. $log->warn("illegal refName: $refName");
  4293. $refName=undef;
  4294. }
  4295. return $refName;
  4296. }
  4297. sub unescapeRefNameChar
  4298. {
  4299. my($char)=@_;
  4300. if($char eq "s")
  4301. {
  4302. $char="/";
  4303. }
  4304. elsif($char eq "p")
  4305. {
  4306. $char=".";
  4307. }
  4308. elsif($char eq "u")
  4309. {
  4310. $char="_";
  4311. }
  4312. elsif($char=~/^[0-9a-f][0-9a-f]$/)
  4313. {
  4314. $char=chr(hex($char));
  4315. }
  4316. else
  4317. {
  4318. # Error case: Maybe it has come straight from user, and
  4319. # wasn't supposed to be escaped? Restore it the way we got it:
  4320. $char="_-$char-";
  4321. }
  4322. return $char;
  4323. }
  4324. =head2 in_array()
  4325. from Array::PAT - mimics the in_array() function
  4326. found in PHP. Yuck but works for small arrays.
  4327. =cut
  4328. sub in_array
  4329. {
  4330. my ($check, @array) = @_;
  4331. my $retval = 0;
  4332. foreach my $test (@array){
  4333. if($check eq $test){
  4334. $retval = 1;
  4335. }
  4336. }
  4337. return $retval;
  4338. }
  4339. =head2 mangle_dirname
  4340. create a string from a directory name that is suitable to use as
  4341. part of a filename, mainly by converting all chars except \w.- to _
  4342. =cut
  4343. sub mangle_dirname {
  4344. my $dirname = shift;
  4345. return unless defined $dirname;
  4346. $dirname =~ s/[^\w.-]/_/g;
  4347. return $dirname;
  4348. }
  4349. =head2 mangle_tablename
  4350. create a string from a that is suitable to use as part of an SQL table
  4351. name, mainly by converting all chars except \w to _
  4352. =cut
  4353. sub mangle_tablename {
  4354. my $tablename = shift;
  4355. return unless defined $tablename;
  4356. $tablename =~ s/[^\w_]/_/g;
  4357. return $tablename;
  4358. }
  4359. 1;