diff --git a/modules/ksb/BuildContext.pm b/modules/ksb/BuildContext.pm index 01a885c..5cac699 100644 --- a/modules/ksb/BuildContext.pm +++ b/modules/ksb/BuildContext.pm @@ -1,1037 +1,1037 @@ package ksb::BuildContext 0.35; # Class: BuildContext # # This contains the information needed about the build context, e.g. list of # modules, what phases each module is in, the various options, etc. use 5.014; use warnings; no if $] >= 5.018, 'warnings', 'experimental::smartmatch'; use Carp 'confess'; use File::Basename; # dirname use IO::File; use POSIX qw(strftime); use Errno qw(:POSIX); use JSON::PP; # We derive from ksb::Module so that BuildContext acts like the 'global' # ksb::Module, with some extra functionality. # TODO: Derive from OptionsBase directly and remove getOption override use parent qw(ksb::Module); use ksb::BuildException; use ksb::Debug; use ksb::Util; use ksb::PhaseList; use ksb::Module; use ksb::Module::BranchGroupResolver; use ksb::Updater::KDEProjectMetadata 0.20; use ksb::Version qw(scriptVersion); use ksb::StatusView; use ksb::KDEProjectsReader 0.50; use File::Temp qw(tempfile); use File::Spec; # rel2abs my @DefaultPhases = qw/update build install/; my @rcfiles = ("./kdesrc-buildrc", "$ENV{HOME}/.kdesrc-buildrc"); my $LOCKFILE_NAME = '.kdesrc-lock'; # The # will be replaced by the directory the rc File is stored in. my $PERSISTENT_FILE_NAME = '#/.kdesrc-build-data'; my $SCRIPT_VERSION = scriptVersion(); # Should be used for internal state that shouldn't be exposed as a hidden # cmdline option, or has other cmdline switches (e.g. debug/verbose handling). my %internalGlobalOptions = ( "async" => 1, "build-system-only" => "", "build-when-unchanged" => 1, # Safe default "checkout-only" => "", "colorful-output" => 1, # Use color by default. "debug-level" => ksb::Debug::INFO, "filter-out-phases" => '', "git-desired-protocol" => 'https', # protocol to grab from kde-projects "git-repository-base" => {}, # Base path template for use multiple times. "ignore-modules" => '', # See also: use-modules, kde-projects "include-dependencies" => 0, # Recursively include kde-projects module deps? "manual-build" => "", "manual-update" => "", "niceness" => "10", "no-svn" => "", # TODO: Rename to no-src "prefix" => "", # Override installation prefix. "pretend" => "", "reconfigure" => "", "refresh-build" => "", "repository" => '', # module's git repo "revision" => '', # Only useful for Subversion modules at cmdline "set-env" => { }, # Hash of environment vars to set "ssh-identity-file" => '', # If set, is passed to ssh-add. "use-modules" => "", - "x-invent-kde-push-urls" => 0, # 2020-12-04 temporary feature flag to use invent.kde.org for push URLs for KDE + "x-invent-kde-push-urls" => 1, # 2020-05-17 temporary feature flag to use invent.kde.org for push URLs for KDE # projects ); # Holds boolean flags that could be altered from cmdline. # These must be completely disjoint from the options provided in # ksb::Application to GetOptionsFromArray! our %defaultGlobalFlags = ( "delete-my-patches" => 0, # Should only be set from cmdline "delete-my-settings" => 0, # Should only be set from cmdline "disable-agent-check" => 0, # If true we don't check on ssh-agent "disable-snapshots" => 1, # 2016-07-31 Temp. disabled until kde.org fixed to supply snapshots "ignore-kde-structure" => 0, # Whether to use kde dir structure like extragear/network "include-dependencies" => 0, # 2019-08-31 Made negatable from cmdline (NB: false here but true in rcfile) "install-after-build" => 1, "install-environment-driver" => 1, # Setup ~/.config/kde-env-*.sh for login scripts "install-session-driver" => 0, # Above, + ~/.xsession "purge-old-logs" => 1, "run-tests" => 0, # 1 = make test, upload = make Experimental "stop-on-failure" => 0, "use-clean-install" => 0, "use-idle-io-priority" => 0, "use-stable-kde" => 0, ); # Holds other cmdline-accessible options that aren't simply binary flags. our %defaultGlobalOptions = ( "binpath" => '', "branch" => "", "branch-group" => "", # Overrides branch, uses JSON data. "build-dir" => "build", "cmake-options" => "", "configure-flags" => "", "custom-build-command" => '', "cxxflags" => "-pipe", "dest-dir" => '${MODULE}', # single quotes used on purpose! "do-not-compile" => "", "http-proxy" => '', # Proxy server to use for HTTP. "kdedir" => "$ENV{HOME}/kde", "kde-languages" => "", "libpath" => "", "log-dir" => "log", "make-install-prefix" => "", # Some people need sudo "make-options" => "", "module-base-path" => "", # Used for tags and branches "override-build-system"=> "", "override-url" => "", "persistent-data-file" => "", "qtdir" => "", "remove-after-install" => "none", # { none, builddir, all } "source-dir" => "$ENV{HOME}/kdesrc", "svn-server" => "svn://anonsvn.kde.org/home/kde", "tag" => "", ); sub new { my ($class, @args) = @_; # It is very important to use the ksb::Module:: syntax instead of ksb::Module->, # otherwise you can't pass $class and have it used as the classname. my $self = ksb::Module::new($class, undef, 'global'); my %newOpts = ( modules => [], context => $self, # Fix link to buildContext (i.e. $self) build_options => { global => { %internalGlobalOptions, %defaultGlobalFlags, %defaultGlobalOptions, }, # Module options are stored under here as well, keyed by module->name() }, # This one replaces ksb::Module::{phases} phases => ksb::PhaseList->new(@DefaultPhases), errors => { # A map from module *names* (as in modules[] above) to the # phase name at which they failed. }, logPaths=> { # Holds a hash table of log path bases as expanded by # getSubdirPath (e.g. [source-dir]/log) to the actual log dir # *this run*, with the date and unique id added. You must still # add the module name to use. }, rcFiles => [@rcfiles], rcFile => undef, env => { }, persistent_options => { }, # These are kept across multiple script runs ignore_list => [ ], # List of KDE project paths to ignore completely kde_projects_metadata => undef, # Enumeration of kde-projects kde_dependencies_metadata => undef, # Dependency resolution of kde-projects logical_module_resolver => undef, # For branch-group option status_view => ksb::StatusView->new(), projects_db => undef, # See getProjectDataReader ); # Merge all new options into our self-hash. @{$self}{keys %newOpts} = values %newOpts; $self->{options} = $self->{build_options}{global}; assert_isa($self, 'ksb::Module'); assert_isa($self, 'ksb::BuildContext'); return $self; } # Gets the ksb::PhaseList for this context, and optionally sets it first to # the ksb::PhaseList passed in. sub phases { my ($self, $phases) = @_; if ($phases) { confess("Invalid type, expected PhaseList") unless $phases->isa('ksb::PhaseList'); $self->{phases} = $phases; } return $self->{phases}; } sub addModule { my ($self, $module) = @_; Carp::confess("No module to push") unless $module; my $path; if (list_has($self->{modules}, $module)) { debug("Skipping duplicate module ", $module->name()); } # TODO: Shouldn't this support all modules, not just 'proj' modules? elsif ($module->scmType() eq 'proj' && ($path = $module->fullProjectPath()) && # See if the name matches any given in the ignore list. any(sub { $path =~ /(^|\/)$_($|\/)/ }, $self->{ignore_list})) { debug("Skipping ignored module $module"); } else { debug("Adding $module to module list"); push @{$self->{modules}}, $module; } } # Returns a listref of the modules to build sub moduleList { my $self = shift; return $self->{modules}; } # Adds a list of modules to ignore processing on completely. # Parameters should simply be a list of KDE project paths to ignore, # e.g. 'extragear/utils/kdesrc-build'. Partial paths are acceptable, matches # are determined by comparing the path provided to the suffix of the full path # of modules being compared. See KDEProjectsReader::_projectPathMatchesWildcardSearch # # Existing items on the ignore list are not removed. sub addToIgnoreList { my $self = shift; push @{$self->{ignore_list}}, @_; } sub setupOperatingEnvironment { my $self = shift; # Set the process priority POSIX::nice(int $self->getOption('niceness')); # Set the IO priority if available. if ($self->getOption('use-idle-io-priority')) { # -p $$ is our PID, -c3 is idle priority # 0 return value means success if (safe_system('ionice', '-c3', '-p', $$) != 0) { warning (" b[y[*] Unable to lower I/O priority, continuing..."); } } # Get ready for logged output. ksb::Debug::setLogFile($self->getLogDirFor($self) . '/build-log'); # Propagate HTTP proxy through environment unless overridden. if ((my $proxy = $self->getOption('http-proxy')) && !defined $ENV{'http_proxy'}) { $self->queueEnvironmentVariable('http_proxy', $proxy); } } # Clears the list of environment variables to set for log_command runs. sub resetEnvironment { my $self = assert_isa(shift, 'ksb::BuildContext'); $self->{env} = { }; } # Adds an environment variable and value to the list of environment # variables to apply for the next subprocess execution. # # Note that these changes are /not/ reflected in the current environment, # so if you are doing something that requires that kind of update you # should do that yourself (but remember to have some way to restore the old # value if necessary). # # In order to keep compatibility with the old 'setenv' sub, no action is # taken if the value is not equivalent to boolean true. sub queueEnvironmentVariable { my $self = assert_isa(shift, 'ksb::BuildContext'); my ($key, $value) = @_; return unless $value; debug ("\tQueueing g[$key] to be set to y[$value]"); $self->{env}->{$key} = $value; } # Applies all changes queued by queueEnvironmentVariable to the actual # environment irretrievably. Use this before exec()'ing another child, for # instance. sub commitEnvironmentChanges { my $self = assert_isa(shift, 'ksb::BuildContext'); while (my ($key, $value) = each %{$self->{env}}) { $ENV{$key} = $value; debug ("\tSetting environment variable g[$key] to g[b[$value]"); } } # Adds the given library paths to the path already given in an environment # variable. In addition, detected "system paths" are stripped to ensure # that we don't inadvertently re-add a system path to be promoted over the # custom code we're compiling (for instance, when a system Qt is used and # installed to /usr). # # If the environment variable to be modified has already been queued using # queueEnvironmentVariable, then that (queued) value will be modified and # will take effect with the next forked subprocess. # # Otherwise, the current environment variable value will be used, and then # queued. Either way the current environment will be unmodified afterward. # # First parameter is the name of the environment variable to modify # All remaining parameters are prepended to the current environment path, in # the order given. (i.e. param1, param2, param3 -> # param1:param2:param3:existing) sub prependEnvironmentValue { my $self = assert_isa(shift, 'ksb::BuildContext'); my ($envName, @items) = @_; my @curPaths = split(':', $self->{env}->{$envName} // $ENV{$envName} // ''); # Filter out entries to add that are already in the environment from # the system. for my $path (grep { list_has(\@curPaths, $_) } (@items) ) { debug ("\tNot prepending y[$path] to y[$envName] as it appears " . "to already be defined in y[$envName]."); } @items = grep { not list_has(\@curPaths, $_); } (@items); my $envValue = join(':', @items, @curPaths); $envValue =~ s/^:*//; $envValue =~ s/:*$//; # Remove leading/trailing colons $envValue =~ s/:+/:/; # Remove duplicate colons $self->queueEnvironmentVariable($envName, $envValue); } # Tries to take the lock for our current base directory, which currently is # what passes for preventing people from accidentally running kdesrc-build # multiple times at once. The lock is based on the base directory instead # of being global to allow for motivated and/or brave users to properly # configure kdesrc-build to run simultaneously with different # configurations. # # Return value is a boolean success flag. sub takeLock { my $self = assert_isa(shift, 'ksb::BuildContext'); my $baseDir = $self->baseConfigDirectory(); my $lockfile = "$baseDir/$LOCKFILE_NAME"; $! = 0; # Force reset to non-error status sysopen LOCKFILE, $lockfile, O_WRONLY | O_CREAT | O_EXCL; my $errorCode = $!; # Save for later testing. if ($errorCode == EEXIST) { # Path already exists, read the PID and see if it belongs to a # running process. open (my $pidFile, "<", $lockfile) or do { # Lockfile is there but we can't open it?!? Maybe a race # condition but I have to give up somewhere. warning (" WARNING: Can't open or create lockfile r[$lockfile]"); return 1; }; my $pid = <$pidFile>; close $pidFile; if ($pid) { # Recent kdesrc-build; we wrote a PID in there. chomp $pid; # See if something's running with this PID. if (kill(0, $pid) == 1) { # Something *is* running, likely kdesrc-build. Don't use error, # it'll scan for $! print ksb::Debug::colorize(" r[*y[*r[*] kdesrc-build appears to be running. Do you want to:\n"); print ksb::Debug::colorize(" (b[Q])uit, (b[P])roceed anyways?: "); my $choice = // ''; chomp $choice; if (lc $choice ne 'p') { say ksb::Debug::colorize(" y[*] kdesrc-build run canceled."); return 0; } # We still can't grab the lockfile, let's just hope things # work out. note (" y[*] kdesrc-build run in progress by user request."); return 1; } # If we get here, then the program isn't running (or at least not # as the current user), so allow the flow of execution to fall # through below and unlink the lockfile. } # pid # No pid found, optimistically assume the user isn't running # twice. warning (" y[WARNING]: stale kdesrc-build lockfile found, deleting."); unlink $lockfile; sysopen (LOCKFILE, $lockfile, O_WRONLY | O_CREAT | O_EXCL) or do { error (" r[*] Still unable to lock $lockfile, proceeding anyways..."); return 1; }; # Hope the sysopen worked... fall-through } elsif ($errorCode == ENOTTY) { # Stupid bugs... normally sysopen will return ENOTTY, not sure who's to blame between # glibc and Perl but I know that setting PERLIO=:stdio in the environment "fixes" things. ; # pass } elsif ($errorCode != 0) # Some other error occurred. { warning (" r[*]: Error $errorCode while creating lock file (is $baseDir available?)"); warning (" r[*]: Continuing the script for now..."); # Even if we fail it's generally better to allow the script to proceed # without being a jerk about things, especially as more non-CLI-skilled # users start using kdesrc-build to build KDE. return 1; } say LOCKFILE "$$"; close LOCKFILE; return 1; } # Releases the lock obtained by takeLock. sub closeLock { my $self = assert_isa(shift, 'ksb::BuildContext'); my $baseDir = $self->baseConfigDirectory(); my $lockFile = "$baseDir/$LOCKFILE_NAME"; unlink ($lockFile) or warning(" y[*] Failed to close lock: $!"); } # This subroutine accepts a Module parameter, and returns the log directory # for it. You can also pass a BuildContext (including this one) to get the # default log directory. # # As part of setting up what path to use for the log directory, the # 'latest' symlink will also be setup to point to the returned log # directory. sub getLogDirFor { my ($self, $module) = @_; my $baseLogPath = $module->getSubdirPath('log-dir'); my $logDir; if (!exists $self->{logPaths}{$baseLogPath}) { # No log dir made for this base, do so now. my $id = '01'; my $date = strftime "%F", localtime; # ISO 8601 date $id++ while -e "$baseLogPath/$date-$id"; $self->{logPaths}{$baseLogPath} = "$baseLogPath/$date-$id"; } $logDir = $self->{logPaths}{$baseLogPath}; super_mkdir($logDir); # global logs go to basedir directly $logDir .= "/$module" unless $module->isa('ksb::BuildContext'); return $logDir; } # Constructs the appropriate full path to a log file based on the given # basename (including extensions). Use this instead of getLogDirFor when you # actually intend to create a log, as this function will also adjust the # 'latest' symlink properly. sub getLogPathFor { my ($self, $module, $path) = @_; my $baseLogPath = $module->getSubdirPath('log-dir'); my $logDir = $self->getLogDirFor($module); # We create this here to avoid needless empty module directories everywhere super_mkdir($logDir); # Add a symlink to the latest run for this module. 'latest' itself is # a directory under the base log directory that holds symlinks mapping # each module name to the specific log directory most recently used. my $latestPath = "$baseLogPath/latest"; # Handle stuff like playground/utils or KDE/kdelibs my ($moduleName, $modulePath) = fileparse($module->name()); $latestPath .= "/$modulePath" if $module->name() =~ m(/); super_mkdir($latestPath); my $symlink = "$latestPath/$moduleName"; if (-l $symlink and readlink($symlink) ne $logDir) { unlink($symlink); symlink($logDir, $symlink); } elsif(not -e $symlink) { # Create symlink initially if we've never done it before. symlink($logDir, $symlink); } return "$logDir/$path"; } # Returns rc file in use. Call loadRcFile first. sub rcFile { my $self = shift; return $self->{rcFile}; } # Forces the rc file to be read from to be that given by the first # parameter. sub setRcFile { my ($self, $file) = @_; $self->{rcFiles} = [$file]; $self->{rcFile} = undef; } # Returns an open filehandle to the user's chosen rc file. Use setRcFile # to choose a file to load before calling this function, otherwise # loadRcFile will search the default search path. After this function is # called, rcFile() can be used to determine which file was loaded. # # If unable to find or open the rc file an exception is raised. Empty rc # files are supported however. sub loadRcFile { my $self = shift; my @rcFiles = @{$self->{rcFiles}}; my $fh; for my $file (@rcFiles) { if (open ($fh, '<', "$file")) { $self->{rcFile} = File::Spec->rel2abs($file); return $fh; } } # No rc found, check if we can use default. if (scalar @rcFiles == 1) { # This can only happen if the user uses --rc-file, so if we fail to # load the file, we need to fail to load at all. my $failedFile = $rcFiles[0]; error (<rcFile() or croak_internal("Call to baseConfigDirectory before loadRcFile"); return dirname($rcfile); } sub modulesInPhase { my ($self, $phase) = @_; my @list = grep { list_has([$_->phases()->phases()], $phase) } (@{$self->moduleList()}); return @list; } # Searches for a module with a name that matches the provided parameter, # and returns its ksb::Module object. Returns undef if no match was found. # As a special-case, returns the BuildContext itself if the name passed is # 'global', since the BuildContext also is a (in the "is-a" OOP sense) # ksb::Module, specifically the 'global' one. sub lookupModule { my ($self, $moduleName) = @_; return $self if $moduleName eq 'global'; my @options = grep { $_->name() eq $moduleName } (@{$self->moduleList()}); return undef unless @options; if (scalar @options > 1) { croak_internal("Detected 2 or more $moduleName ksb::Module objects"); } return $options[0]; } sub markModulePhaseFailed { my ($self, $phase, $module) = @_; assert_isa($module, 'ksb::Module'); $self->{errors}->{$module->name()} = $phase; } # Returns a list (i.e. not a reference to, but a real list) of Modules that failed to # complete the given phase. sub failedModulesInPhase { my ($self, $phase) = @_; my @failures = grep { ($self->{errors}->{$_->name()} // '') eq $phase } (@{$self->moduleList()}); return @failures; } # Returns a list of modules that had a failure of some sort, in the order the modules # are listed in our current module list. sub listFailedModules { my $self = shift; my @modules = @{$self->moduleList()}; # grepping for failures instead of returning error list directly maintains ordering @modules = grep { exists $self->{errors}->{$_->name()} } (@modules); return @modules; } # OVERRIDE: Our immediate parent class Module overrides this, but we actually # want the OptionsBase version to be used instead, until we break the recursive # use of Module's own getOption calls on our getOption. sub getOption { &ksb::OptionsBase::getOption; } # OVERRIDE: Overrides OptionsBase::setOption to handle some global-only options. sub setOption { my ($self, %options) = @_; # Special-case handling my $repoOption = 'git-repository-base'; if (exists $options{$repoOption}) { my $value = $options{$repoOption}; my ($repo, $url) = ($value =~ /^([a-zA-Z0-9_-]+)\s+(.+)$/); # This will be a hash reference instead of a scalar $value = $self->getOption($repoOption) || { }; if (!$repo || !$url) { die ksb::BuildException::Config->new($repoOption, "Invalid git-repository-base setting: $value"); } $value->{$repo} = $url; delete $options{$repoOption}; } # Actually set options. $self->SUPER::setOption(%options); # Automatically respond to various global option changes. while (my ($key, $value) = each %options) { my $normalizedKey = $key; $normalizedKey =~ s/^#//; # Remove sticky key modifier. given ($normalizedKey) { when ('colorful-output') { ksb::Debug::setColorfulOutput($value); } when ('debug-level') { ksb::Debug::setDebugLevel($value); } when ('pretend') { ksb::Debug::setPretending($value); } } } } # # Persistent option handling # # Returns the name of the file to use for persistent data. # Supports expanding '#' at the beginning of the filename to the directory # containing the rc-file in use, but only for the default name at this # point. sub persistentOptionFileName { my $self = shift; my $filename = $self->getOption('persistent-data-file'); if (!$filename) { $filename = $PERSISTENT_FILE_NAME; my $dir = $self->baseConfigDirectory(); $filename =~ s/^#/$dir/; } else { # Tilde-expand $filename =~ s/^~\//$ENV{HOME}\//; } return $filename; } # Reads in all persistent options from the file where they are kept # (.kdesrc-build-data) for use in the program. # # The directory used is the same directory that contains the rc file in use. sub loadPersistentOptions { my $self = assert_isa(shift, 'ksb::BuildContext'); my $fh = IO::File->new($self->persistentOptionFileName(), '<'); return unless $fh; # $persistent_data should be a JSON object which we can store directly as a # hash. my $persistent_data; { local $/ = undef; # Read in whole file with <> operator. $persistent_data = <$fh>; } my $persistent_options; eval { $persistent_options = decode_json($persistent_data); }; if ($@) { # Apparently wasn't JSON, try falling back to old format for compat. # Previously, this was a Perl code which, when evaluated would give # us a hash called persistent_options which we can then merge into our # persistent options. # TODO: Remove compat code after 2018-06-30 eval $persistent_data; # Runs Perl code read from file if ($@) { # Failed. error ("Failed to read persistent module data: r[b[$@]"); return; } } # We need to keep persistent data with the context instead of with the # applicable modules since otherwise we might forget to write out # persistent data for modules we didn't build in this run. So, we just # store it all. # Layout of this data: # $self->persistent_options = { # 'module-name' => { # option => value, # # foreach option/value pair # }, # # foreach module # } $persistent_options = {} if ref $persistent_options ne 'HASH'; $self->{persistent_options} = $persistent_options; } # Writes out the persistent options to the file .kdesrc-build-data. # # The directory used is the same directory that contains the rc file in use. sub storePersistentOptions { my $self = assert_isa(shift, 'ksb::BuildContext'); return if pretending(); my $fh = IO::File->new($self->persistentOptionFileName(), '>'); my $json = JSON::PP->new->ascii->pretty; if (!$fh) { error ("Unable to save persistent module data: b[r[$!]"); return; } my $encodedJSON = $json->encode($self->{persistent_options}); print $fh $encodedJSON; undef $fh; # Closes the file } # Returns the value of a "persistent" option (normally read in as part of # startup), or undef if there is no value stored. # # First parameter is the module name to get the option for, or 'global' if # not for a module. # Note that unlike setOption/getOption, no inheritance is done at this # point so if an option is present globally but not for a module you # must check both if that's what you want. # Second parameter is the name of the value to retrieve (i.e. the key) sub getPersistentOption { my ($self, $moduleName, $key) = @_; my $persistent_opts = $self->{persistent_options}; # We must check at each level of indirection to avoid # "autovivification" return unless exists $persistent_opts->{$moduleName}; return unless exists $persistent_opts->{$moduleName}{$key}; return $persistent_opts->{$moduleName}{$key}; } # Clears a persistent option if set (for a given module and option-name). # # First parameter is the module name to get the option for, or 'global' for # the global options. # Second parameter is the name of the value to clear. # No return value. sub unsetPersistentOption { my ($self, $moduleName, $key) = @_; my $persistent_opts = $self->{persistent_options}; if (exists $persistent_opts->{$moduleName} && exists $persistent_opts->{$moduleName}->{$key}) { delete $persistent_opts->{$moduleName}->{$key}; } } # Sets a "persistent" option which will be read in for a module when # kdesrc-build starts up and written back out at (normal) program exit. # # First parameter is the module name to set the option for, or 'global'. # Second parameter is the name of the value to set (i.e. key) # Third parameter is the value to store, which must be a scalar. sub setPersistentOption { my ($self, $moduleName, $key, $value) = @_; my $persistent_opts = $self->{persistent_options}; # Initialize empty hash ref if nothing defined for this module. $persistent_opts->{$moduleName} //= { }; $persistent_opts->{$moduleName}{$key} = $value; } # Returns the ksb::Module (which has a 'metadata' scm type) that is used for # kde-build-metadata, so that other modules that need it can call into it if # necessary. # # Also may return undef if the metadata is unavailable or has not yet # been set by setKDEDependenciesMetadataModule (this method does not # automatically create the needed module). sub getKDEDependenciesMetadataModule { my $self = shift; return $self->{kde_dependencies_metadata}; } # Returns the ksb::Module (which has a 'metadata' scm type) that is used for # kde-project metadata, so that other modules that need it can call into it if # necessary. # # Also may return undef if the metadata is unavailable or has not yet # been set by setKDEProjectsMetadataModule (this method does not # automatically create the needed module). sub getKDEProjectsMetadataModule { my $self = shift; return $self->{kde_projects_metadata}; } # Call this method to force this build context to pull in the kde-build-metadata # module. This is a one-time action, subsequent calls to this method # are ignored. Use getKDEDependenciesMetadataModule to see if this build context is # using a metadata module. # # This method should be called before setModuleList. sub setKDEDependenciesMetadataModuleNeeded { my $self = assert_isa(shift, 'ksb::BuildContext'); return if defined $self->{kde_dependencies_metadata}; my $metadata = ksb::ModuleSet::KDEProjects::getDependenciesModule($self); debug ("Introducing dependency metadata into the build"); assert_isa($metadata->scm(), 'ksb::Updater::KDEProjectMetadata'); $self->{kde_dependencies_metadata} = $metadata; return; } # Call this method to force this build context to pull in the # sysadmin/repo-metadata module. This is a one-time action, # subsequent calls to this method are ignored. Use # getKDEProjectsMetadataModule to see if this build context is using # a metadata module. # # This method should be called before setModuleList. sub setKDEProjectsMetadataModuleNeeded { my $self = assert_isa(shift, 'ksb::BuildContext'); return if defined $self->{kde_projects_metadata}; my $metadata = ksb::ModuleSet::KDEProjects::getProjectMetadataModule($self); debug ("Introducing project enumeration metadata into the build"); assert_isa($metadata->scm(), 'ksb::Updater::KDEProjectMetadata'); $self->{kde_projects_metadata} = $metadata; return; } # Returns a KDEProjectsReader module, which has already read in the database and # is ready to be queried. Note that exceptions can be thrown in the process # of downloading and parsing the database information, so be ready for that. sub getProjectDataReader { my $self = shift; return $self->{projects_db} if $self->{projects_db}; my $projectDatabaseModule = $self->getKDEProjectsMetadataModule() or croak_runtime("kde-projects repository information could not be downloaded: $!"); $self->{projects_db} = ksb::KDEProjectsReader->new($projectDatabaseModule); return $self->{projects_db}; } # Returns the effective branch group to use for modules. You should not call # this unless kde-build-metadata is also in use (see # setKDEDependenciesMetadataModule and moduleBranchGroupResolver). sub effectiveBranchGroup { my $self = shift; my $branchGroup = $self->getOption('branch-group', 'module') // ''; if (!$branchGroup) { $branchGroup = $self->getOption('use-stable-kde') ? 'latest-qt4' : ($self->hasOption('use-stable-kde') # Could also be false if unset ? 'kf5-qt5' # Really set to false : 'latest-qt4'); # Unset / this is default branch group if no option set } return $branchGroup; } # Returns a ksb::Module::BranchGroupResolver which can be used to efficiently # determine a git branch to use for a given kde-projects module (when the # branch-group option is in use), as specified at # https://community.kde.org/Infrastructure/Project_Metadata. sub moduleBranchGroupResolver { my $self = shift; if (!$self->{logical_module_resolver}) { my $metadataModule = $self->getKDEDependenciesMetadataModule(); croak_internal("Tried to use branch-group, but needed data wasn't loaded!") unless $metadataModule; my $resolver = ksb::Module::BranchGroupResolver->new( $metadataModule->scm()->logicalModuleGroups()); $self->{logical_module_resolver} = $resolver; } return $self->{logical_module_resolver}; } sub statusViewer { my $self = shift; return $self->{status_view}; } 1; diff --git a/modules/ksb/KDEProjectsReader.pm b/modules/ksb/KDEProjectsReader.pm index 451ab59..2b6e3ee 100644 --- a/modules/ksb/KDEProjectsReader.pm +++ b/modules/ksb/KDEProjectsReader.pm @@ -1,231 +1,231 @@ package ksb::KDEProjectsReader 0.50; # Class: KDEProjectsReader # # Enumerates and provides basic metadata of KDE projects, based on # the YAML metadata included in sysadmin/repo-management. use strict; use warnings; use 5.014; use File::Find; use ksb::BuildException; sub _verifyYAMLModuleLoaded { # Load YAML-reading module if available without causing compile error if it # isn't. Note that YAML::Tiny and YAML do not work since some metadata files # use features it doesn't support my @YAML_Opts = qw(Dump Load LoadFile); my @YAML_Mods = qw(YAML::XS YAML::Syck YAML::PP); my $success = 0; foreach my $mod (@YAML_Mods) { $success ||= eval "require $mod; $mod->import(\@YAML_Opts); 1;"; last if $success; } if (!$success) { die "Unable to load one of " . join(', ', @YAML_Mods) . " modules, one of which is needed to handle KDE project data."; } } # Method: new # # Constructs a new KDEProjectsReader. This doesn't contradict any part of the class # documentation which claims this class is a singleton however. This should be # called as a method (e.g. KDEProjectsReader->new(...)). # # Parameters: # $projectMetadataModule - ksb::Module reference to the repo-metadata module. sub new { my $class = shift; my $projectMetadataModule = shift; _verifyYAMLModuleLoaded(); my $self = { # Maps short names to repo info blocks repositories => { } }; $self = bless ($self, $class); $self->_readProjectData($projectMetadataModule); return $self; } # The 'main' method for this class. Reads in *all* KDE projects and notes # their details for later queries. # Be careful, can throw exceptions. sub _readProjectData { my ($self, $projectMetadataModule) = @_; my $srcdir = $projectMetadataModule->fullpath('source'); croak_runtime("No such source directory $srcdir!") unless -d $srcdir; my $files_searched = 0; File::Find::find({ wanted => sub { if ($_ eq 'metadata.yaml') { $self->_readYAML($_); $files_searched++; } }, follow => 1, }, "$srcdir/projects"); croak_runtime("Failed to find KDE project entries from $srcdir!") unless $files_searched > 0; } sub _readYAML { my ($self, $filename) = @_; my $proj_data = LoadFile($filename); if (!$proj_data->{repoactive} || !$proj_data->{hasrepo} || # # previously there used to be a check on 'type' which # only caught two specific cases: everything else was # already covered by the hasrepo/repoactive checks. # # replace the type assertion with a specific check on the # projects that would otherwise have been ignored # ($proj_data->{projectpath} eq 'kde-build-metadata' || $proj_data->{projectpath} eq 'repo-management')) { return; }; my $repoPath = $proj_data->{repopath}; my $repoName = $proj_data->{identifier} // $repoPath; my $curRepository = { 'fullName' => $proj_data->{projectpath}, - 'repo' => "kde:$repoPath", + 'repo' => "kde:$repoPath.git", 'name' => $repoName, 'active' => !!$proj_data->{repoactive}, 'found_by' => 'direct', # can be changed in getModulesForProject }; $self->{repositories}->{$repoName} = $curRepository; } # Note on $proj: A /-separated path is fine, in which case we look # for the right-most part of the full path which matches all of searchProject. # e.g. kde/kdebase/kde-runtime would be matched by a proj of either # "kdebase/kde-runtime" or simply "kde-runtime". sub getModulesForProject { my ($self, $proj) = @_; my $repositoryRef = $self->{repositories}; my @results; my $findResults = sub { my @matchList = grep { _projectPathMatchesWildcardSearch( $repositoryRef->{$_}->{'fullName'}, $proj) } (sort keys %{$repositoryRef}); if ($proj =~ m/\*/) { $repositoryRef->{$_}->{found_by} = 'wildcard' foreach @matchList; } push @results, @matchList; }; # Wildcard matches happen as specified if asked for. # Non-wildcard matches have an implicit "$proj/*" search as well for # compatibility with previous use-modules # Project specifiers ending in .git are forced to be non-wildcarded. if ($proj !~ /\*/ && $proj !~ /\.git$/) { # We have to do a search to account for over-specified module names # like phonon/phonon $findResults->(); # Now setup for a wildcard search to find things like kde/kdelibs/baloo # if just 'kdelibs' is asked for. $proj .= '/*'; } $proj =~ s/\.git$//; # If still no wildcard and no '/' then we can use direct lookup by module # name. if ($proj !~ /\*/ && $proj !~ /\// && exists $repositoryRef->{$proj}) { push @results, $proj; } else { $findResults->(); } return @{$repositoryRef}{@results}; } # Utility subroutine, returns true if the given kde-project full path (e.g. # kde/kdelibs/nepomuk-core) matches the given search item. # # The search item itself is based on path-components. Each path component in # the search item must be present in the equivalent path component in the # module's project path for a match. A '*' in a path component position for the # search item matches any project path component. # # Finally, the search is pinned to search for a common suffix. E.g. a search # item of 'kdelibs' would match a project path of 'kde/kdelibs' but not # 'kde/kdelibs/nepomuk-core'. However 'kdelibs/*' would match # 'kde/kdelibs/nepomuk-core'. # # First parameter is the full project path from the kde-projects database. # Second parameter is the search item. # Returns true if they match, false otherwise. sub _projectPathMatchesWildcardSearch { my ($projectPath, $searchItem) = @_; my @searchParts = split(m{/}, $searchItem); my @nameStack = split(m{/}, $projectPath); if (scalar @nameStack >= scalar @searchParts) { my $sizeDifference = scalar @nameStack - scalar @searchParts; # We might have to loop if we somehow find the wrong start point for our search. # E.g. looking for a/b/* against a/a/b/c, we'd need to start with the second a. my $i = 0; while ($i <= $sizeDifference) { # Find our common prefix, then ensure the remainder matches item-for-item. for (; $i <= $sizeDifference; $i++) { last if $nameStack[$i] eq $searchParts[0]; } return if $i > $sizeDifference; # Not enough room to find it now # At this point we have synched up nameStack to searchParts, ensure they # match item-for-item. my $found = 1; for (my $j = 0; $found && ($j < @searchParts); $j++) { return 1 if $searchParts[$j] eq '*'; # This always works $found = 0 if $searchParts[$j] ne $nameStack[$i + $j]; } return 1 if $found; # We matched every item to the substring we found. $i++; # Try again } } return; } 1; diff --git a/modules/ksb/ModuleSet/KDEProjects.pm b/modules/ksb/ModuleSet/KDEProjects.pm index a394730..4ee12c6 100644 --- a/modules/ksb/ModuleSet/KDEProjects.pm +++ b/modules/ksb/ModuleSet/KDEProjects.pm @@ -1,226 +1,226 @@ package ksb::ModuleSet::KDEProjects 0.30; # Class: ModuleSet::KDEProjects # # This represents a collective grouping of modules that share common options, # based on the KDE project repositories. Metadata for that repository is # itself housed in a dedicated KDE.org git repository "sysadmin/repo-metadata", # which this class uses to imbue ksb::Modules generated by this ModuleSet. # # The only changes here are to allow for expanding out module specifications # (except for ignored modules), by using KDEProjectsReader. # # See also: ModuleSet use strict; use warnings; use 5.014; use parent qw(ksb::ModuleSet); no if $] >= 5.018, 'warnings', 'experimental::smartmatch'; use ksb::BuildContext 0.20; use ksb::BuildException; use ksb::Debug; use ksb::KDEProjectsReader 0.50; use ksb::Module; use ksb::Util; sub new { my $self = ksb::ModuleSet::new(@_); $self->{projectsDataReader} = undef; # Will be filled in when we get fh return $self; } # Simple utility subroutine. See List::Util's perldoc sub none_true { ($_ && return 0) for @_; return 1; } sub _createMetadataModule { my ($ctx, $moduleName) = @_; my $metadataModule = ksb::Module->new($ctx, $moduleName =~ s,/,-,r); # Hardcode the results instead of expanding out the project info $metadataModule->setOption('repository', "kde:$moduleName"); $metadataModule->setOption('#xml-full-path', $moduleName); $metadataModule->setOption('#branch:stable', 'master'); $metadataModule->setScmType('metadata'); $metadataModule->setOption('disable-snapshots', 1); $metadataModule->setOption('branch', 'master'); my $moduleSet = ksb::ModuleSet::KDEProjects->new($ctx, ''); $metadataModule->setModuleSet($moduleSet); # Ensure we only ever try to update source, not build. $metadataModule->phases()->phases('update'); return $metadataModule; } # Function: getDependenciesModule # # Static. Returns a that can be used to download the # 'kde-build-metadata' module, which itself contains module dependencies # in the KDE build system. The module is meant to be held by the # # Parameters: # ctx - the for this script execution. sub getDependenciesModule { my $ctx = assert_isa(shift, 'ksb::BuildContext'); - return _createMetadataModule($ctx, 'kde-build-metadata'); + return _createMetadataModule($ctx, 'sysadmin/kde-build-metadata'); } # Function: getProjectMetadataModule # # Static. Returns a that can be used to download the # 'repo-metadata' module, which itself contains information on each # repository in the KDE build system (though currently not # dependencies). The module is meant to be held by the # # Parameters: # ctx - the for this script execution. sub getProjectMetadataModule { my $ctx = assert_isa(shift, 'ksb::BuildContext'); return _createMetadataModule($ctx, 'sysadmin/repo-metadata'); } # Function: _expandModuleCandidates # # A class method which goes through the modules in our search list (assumed to # be found in kde-projects), expands them into their equivalent git modules, # and returns the fully expanded list. Non kde-projects modules cause an error, # as do modules that do not exist at all within the database. # # *Note*: Before calling this function, the kde-projects database itself must # have been downloaded first. See getProjectMetadataModule, which ties to the # BuildContext. # # Modules that are part of a module-set requiring a specific branch, that don't # have that branch, are still listed in the return result since there's no way # to tell that the branch won't be there. These should be removed later. # # Parameters: # ctx - The in use. # moduleSearchItem - The search description to expand in ksb::Modules. See # _projectPathMatchesWildcardSearch for a description of the syntax. # # Returns: # @modules - List of expanded git . # # Throws: # Runtime - if the kde-projects database was required but couldn't be # downloaded or read. # Runtime - if the git-desired-protocol is unsupported. # Runtime - if an "assumed" kde-projects module was not actually one. sub _expandModuleCandidates { my $self = assert_isa(shift, 'ksb::ModuleSet::KDEProjects'); my $ctx = assert_isa(shift, 'ksb::BuildContext'); my $moduleSearchItem = shift; whisper("There are " . (scalar keys %{$ctx->getProjectDataReader()->{repositories}}) . " repos in db."); my @allModuleResults = $ctx-> getProjectDataReader()-> getModulesForProject($moduleSearchItem); croak_runtime ("Unknown KDE project: $moduleSearchItem") unless @allModuleResults; # It's possible to match modules which are marked as inactive on # projects.kde.org, elide those. my @activeResults = grep { $_->{'active'} } (@allModuleResults); if (!@activeResults) { warning (" y[b[*] Module y[$moduleSearchItem] is apparently a KDE collection, but contains no\n" . "active modules to build!"); my $count = scalar @allModuleResults; if ($count > 0) { warning ("\tAlthough no active modules are available, there were\n" . "\t$count inactive modules. Perhaps the git modules are not ready?"); } } # Setup module options. my @moduleList; my @ignoreList = $self->modulesToIgnore(); foreach (@activeResults) { my $result = $_; my $newModule = ksb::Module->new($ctx, $result->{'name'}); $self->_initializeNewModule($newModule); $newModule->setOption('repository', $result->{'repo'}); $newModule->setOption('#xml-full-path', $result->{'fullName'}); $newModule->setOption('#branch:stable', undef); $newModule->setOption('#found-by', $result->{found_by}); $newModule->setScmType('proj'); if (none_true( map { ksb::KDEProjectsReader::_projectPathMatchesWildcardSearch( $result->{'fullName'}, $_ ) } (@ignoreList))) { push @moduleList, $newModule; } else { debug ("--- Ignoring matched active module $newModule in module set " . $self->name()); } }; return @moduleList; } # This function should be called after options are read and build metadata is # available in order to convert this module set to a list of ksb::Module. # Any modules ignored by this module set are excluded from the returned list. # The modules returned have not been added to the build context. sub convertToModules { my ($self, $ctx) = @_; my @moduleList; # module names converted to ksb::Module objects. my %foundModules; # Setup default options for each module # Extraction of relevant kde-project modules will be handled immediately # after this phase of execution. for my $moduleItem ($self->modulesToFind()) { # We might have already grabbed the right module recursively. next if exists $foundModules{$moduleItem}; # eval in case the YAML processor throws an exception. undef $@; my @candidateModules = eval { $self->_expandModuleCandidates($ctx, $moduleItem); }; if ($@) { die $@ if had_an_exception(); # Forward exception objects up croak_runtime("The KDE Project database could not be understood: $@"); } my @moduleNames = map { $_->name() } @candidateModules; @foundModules{@moduleNames} = (1) x @moduleNames; push @moduleList, @candidateModules; } if (not scalar @moduleList) { warning ("No modules were defined for the module-set " . $self->name()); warning ("You should use the g[b[use-modules] option to make the module-set useful."); } return @moduleList; } 1; diff --git a/modules/ksb/Updater/Git.pm b/modules/ksb/Updater/Git.pm index bc08a58..4c3ec5a 100644 --- a/modules/ksb/Updater/Git.pm +++ b/modules/ksb/Updater/Git.pm @@ -1,938 +1,938 @@ package ksb::Updater::Git 0.15; # Module which is responsible for updating git-based source code modules. Can # have some features overridden by subclassing (see ksb::Updater::KDEProject # for an example). use strict; use warnings; use 5.014; use parent qw(ksb::Updater); use ksb::BuildException; use ksb::Debug; use ksb::IPC::Null; use ksb::Util; use File::Basename; # basename use File::Spec; # tmpdir use POSIX qw(strftime); use List::Util qw(first); use IPC::Cmd qw(run_forked); use constant { DEFAULT_GIT_REMOTE => 'origin', }; # scm-specific update procedure. # May change the current directory as necessary. sub updateInternal { my $self = assert_isa(shift, 'ksb::Updater::Git'); my $ipc = shift; $self->{ipc} = $ipc // ksb::IPC::Null->new(); return $self->updateCheckout(); delete $self->{ipc}; } sub name { return 'git'; } sub currentRevisionInternal { my $self = assert_isa(shift, 'ksb::Updater::Git'); return $self->commit_id('HEAD'); } # Returns the current sha1 of the given git "commit-ish". sub commit_id { my $self = assert_isa(shift, 'ksb::Updater::Git'); my $commit = shift or croak_internal("Must specify git-commit to retrieve id for"); my $module = $self->module(); my $gitdir = $module->fullpath('source') . '/.git'; # Note that the --git-dir must come before the git command itself. my ($id, undef) = filter_program_output( undef, # No filter qw/git --git-dir/, $gitdir, 'rev-parse', $commit, ); chomp $id if $id; return $id; } sub _verifyRefPresent { my ($self, $module, $repo) = @_; my ($commitId, $commitType) = $self->_determinePreferredCheckoutSource($module); return 1 if pretending(); my $ref = $commitId; my $hashref = run_forked("git ls-remote --exit-code $repo $ref", { timeout => 10, discard_output => 1, terminate_on_parent_sudden_death => 1}); my $result = $hashref->{exit_code}; return 0 if ($result == 2); # Connection successful, but ref not found return 1 if ($result == 0); # Ref is present croak_runtime("git had error exit $result when verifying $ref present in repository at $repo"); } # Perform a git clone to checkout the latest branch of a given git module # # First parameter is the repository (typically URL) to use. # Throws an exception if it fails. sub _clone { my $self = assert_isa(shift, 'ksb::Updater::Git'); my $git_repo = shift; my $module = $self->module(); my $srcdir = $module->fullpath('source'); my @args = ('--', $git_repo, $srcdir); my $ipc = $self->{ipc} // croak_internal ('Missing IPC object'); note ("Cloning g[$module]"); p_chdir($module->getSourceDir()); my ($commitId, $commitType) = $self->_determinePreferredCheckoutSource($module); $commitId =~ s,^refs/tags/,,; # git-clone -b doesn't like refs/tags/ unshift @args, '-b', $commitId; # Checkout branch right away if (0 != log_command($module, 'git-clone', ['git', 'clone', @args])) { croak_runtime("Failed to make initial clone of $module"); } $ipc->notifyPersistentOptionChange( $module->name(), 'git-cloned-repository', $git_repo); p_chdir($srcdir); # Setup user configuration if (my $name = $module->getOption('git-user')) { my ($username, $email) = ($name =~ /^([^<]+) +<([^>]+)>$/); if (!$username || !$email) { croak_runtime("Invalid username or email for git-user option: $name". " (should be in format 'User Name '"); } whisper ("\tAdding git identity $name for new git module $module"); my $result = (safe_system(qw(git config --local user.name), $username) >> 8) == 0; $result = (safe_system(qw(git config --local user.email), $email) >> 8 == 0) || $result; if (!$result) { warning ("Unable to set user.name and user.email git config for y[b[$module]!"); } } return; } # Checks that the required source dir is either not already present or is empty. # Throws an exception if that's not true. sub _verifySafeToCloneIntoSourceDir { my ($module, $srcdir) = @_; if (-e "$srcdir" && !is_dir_empty($srcdir)) { if ($module->getOption('#delete-my-patches')) { warning ("\tRemoving conflicting source directory " . "as allowed by --delete-my-patches"); warning ("\tRemoving b[$srcdir]"); safe_rmtree($srcdir) or croak_internal("Unable to delete $srcdir!"); } else { error (<module(); my $srcdir = $module->fullpath('source'); if (-d "$srcdir/.git") { # Note that this function will throw an exception on failure. return $self->updateExistingClone(); } else { _verifySafeToCloneIntoSourceDir($module, $srcdir); my $git_repo = $module->getOption('repository'); if (!$git_repo) { croak_internal("Unable to checkout $module, you must specify a repository to use."); } if (!$self->_verifyRefPresent($module, $git_repo)) { croak_runtime( $self->_moduleIsNeeded() ? "$module build was requested, but it has no source code at the requested git branch" : "The required git branch does not exist at the source repository" ); } $self->_clone($git_repo); return 1 if pretending(); return count_command_output('git', '--git-dir', "$srcdir/.git", 'ls-files'); } return 0; } # Intended to be reimplemented sub _moduleIsNeeded { return 1; } # # Determine whether or not _setupRemote should manage the configuration of the git push URL for the repo. # # Return value: boolean indicating whether or not _setupRemote should assume control over the push URL. # sub isPushUrlManaged { return 0; } # # Ensures the given remote is pre-configured for the module's git repository. # The remote is either set up from scratch or its URLs are updated. # # Param $remote name (alias) of the remote to configure # # Throws an exception on error. # sub _setupRemote { my $self = assert_isa(shift, 'ksb::Updater::Git'); my $remote = shift; my $module = $self->module(); my $repo = $module->getOption('repository'); my $hasOldRemote = $self->hasRemote($remote); if ($hasOldRemote) { whisper("\tUpdating the URL for git remote $remote of $module ($repo)"); if (log_command($module, 'git-fix-remote', ['git', 'remote', 'set-url', $remote, $repo]) != 0) { croak_runtime("Unable to update the URL for git remote $remote of $module ($repo)"); } } elsif (log_command($module, 'git-add-remote', ['git', 'remote', 'add', $remote, $repo]) != 0) { whisper("\tAdding new git remote $remote of $module ($repo)"); croak_runtime("Unable to add new git remote $remote of $module ($repo)"); } if ($self->isPushUrlManaged()) { # # pushInsteadOf does not work nicely with git remote set-url --push # The result would be that the pushInsteadOf kde: prefix gets ignored. # # The next best thing is to remove any preconfigured pushurl and restore the kde: prefix mapping that way. # This is effectively the same as updating the push URL directly because of the remote set-url executed # previously by this function for the fetch URL. # chomp (my $existingPushUrl = qx"git config --get remote.$remote.pushurl"); if ($existingPushUrl) { info("\tRemoving preconfigured push URL for git remote $remote of $module: $existingPushUrl"); if (log_command($module, 'git-fix-remote', ['git', 'config', '--unset', "remote.$remote.pushurl"]) != 0) { croak_runtime("Unable to remove preconfigured push URL for git remote $remote of $module: $existingPushUrl"); } } } } # Selects a git remote for the user's selected repository (preferring a # defined remote if available, using 'origin' otherwise). # # Assumes the current directory is already set to the source directory. # # Throws an exception on error. # # Return value: Remote name that should be used for further updates. # # See also the 'repository' module option. sub _setupBestRemote { my $self = assert_isa(shift, 'ksb::Updater::Git'); my $module = $self->module(); my $cur_repo = $module->getOption('repository'); my $ipc = $self->{ipc} // croak_internal ('Missing IPC object'); # Search for an existing remote name first. If none, add our alias. my @remoteNames = $self->bestRemoteName(); my $chosenRemote = @remoteNames ? $remoteNames[0] : DEFAULT_GIT_REMOTE; $self->_setupRemote($chosenRemote); # Make a notice if the repository we're using has moved. my $old_repo = $module->getPersistentOption('git-cloned-repository'); if ($old_repo and ($cur_repo ne $old_repo)) { note (" y[b[*]\ty[$module]'s selected repository has changed"); note (" y[b[*]\tfrom y[$old_repo]"); note (" y[b[*]\tto b[$cur_repo]"); note (" y[b[*]\tThe git remote named b[", DEFAULT_GIT_REMOTE, "] has been updated"); # Update what we think is the current repository on-disk. $ipc->notifyPersistentOptionChange( $module->name(), 'git-cloned-repository', $cur_repo); } return $chosenRemote; } # Completes the steps needed to update a git checkout to be checked-out to # a given remote-tracking branch. Any existing local branch with the given # branch set as upstream will be used if one exists, otherwise one will be # created. The given branch will be rebased into the local branch. # # No checkout is done, this should be performed first. # Assumes we're already in the needed source dir. # Assumes we're in a clean working directory (use git-stash to achieve # if necessary). # # First parameter is the remote to use. # Second parameter is the branch to update to. # Returns boolean success flag. # Exception may be thrown if unable to create a local branch. sub _updateToRemoteHead { my $self = shift; my ($remoteName, $branch) = @_; my $module = $self->module(); # The 'branch' option requests a given head in the user's selected # repository. Normally the remote head is mapped to a local branch, # which can have a different name. So, first we make sure the remote # head is actually available, and if it is we compare its SHA1 with # local branches to find a matching SHA1. Any local branches that are # found must also be remote-tracking. If this is all true we just # re-use that branch, otherwise we create our own remote-tracking # branch. my $branchName = $self->getRemoteBranchName($remoteName, $branch); if (!$branchName) { my $newName = $self->makeBranchname($remoteName, $branch); whisper ("\tUpdating g[$module] with new remote-tracking branch y[$newName]"); if (0 != log_command($module, 'git-checkout-branch', ['git', 'checkout', '-b', $newName, "$remoteName/$branch"])) { croak_runtime("Unable to perform a git checkout of $remoteName/$branch to a local branch of $newName"); } } else { whisper ("\tUpdating g[$module] using existing branch g[$branchName]"); if (0 != log_command($module, 'git-checkout-update', ['git', 'checkout', $branchName])) { croak_runtime("Unable to perform a git checkout to existing branch $branchName"); } # On the right branch, merge in changes. return 0 == log_command($module, 'git-rebase', ['git', 'rebase', "$remoteName/$branch"]); } return 1; } # Completes the steps needed to update a git checkout to be checked-out to # a given commit. The local checkout is left in a detached HEAD state, # even if there is a local branch which happens to be pointed to the # desired commit. Based the given commit is used directly, no rebase/merge # is performed. # # No checkout is done, this should be performed first. # Assumes we're already in the needed source dir. # Assumes we're in a clean working directory (use git-stash to achieve # if necessary). # # First parameter is the commit to update to. This can be in pretty # much any format that git itself will respect (e.g. tag, sha1, etc.). # It is recommended to use refs/$foo/$bar syntax for specificity. # Returns boolean success flag. sub _updateToDetachedHead { my ($self, $commit) = @_; my $module = $self->module(); info ("\tDetaching head to b[$commit]"); return 0 == log_command($module, 'git-checkout-commit', ['git', 'checkout', $commit]); } # Updates an already existing git checkout by running git pull. # # Throws an exception on error. # # Return parameter is the number of affected *commits*. sub updateExistingClone { my $self = assert_isa(shift, 'ksb::Updater::Git'); my $module = $self->module(); my $cur_repo = $module->getOption('repository'); my $result; p_chdir($module->fullpath('source')); # Try to save the user if they are doing a merge or rebase if (-e '.git/MERGE_HEAD' || -e '.git/rebase-merge' || -e '.git/rebase-apply') { croak_runtime ("Aborting git update for $module, you appear to have a rebase or merge in progress!"); } my $remoteName = $self->_setupBestRemote(); # Download updated objects. This also updates remote heads so do this # before we start comparing branches and such. if (0 != log_command($module, 'git-fetch', ['git', 'fetch', '--tags', $remoteName])) { croak_runtime ("Unable to perform git fetch for $remoteName ($cur_repo)"); } # Now we need to figure out if we should update a branch, or simply # checkout a specific tag/SHA1/etc. my ($commitId, $commitType) = $self->_determinePreferredCheckoutSource($module); note ("Updating g[$module] (to $commitType b[$commitId])"); my $start_commit = $self->commit_id('HEAD'); my $updateSub; if ($commitType eq 'branch') { $updateSub = sub { $self->_updateToRemoteHead($remoteName, $commitId) }; } else { $updateSub = sub { $self->_updateToDetachedHead($commitId); } } # With all remote branches fetched, and the checkout of our desired # branch completed, we can now use our update sub to complete the # changes. $self->stashAndUpdate($updateSub); return count_command_output('git', 'rev-list', "$start_commit..HEAD"); } # Goes through all the various combination of git checkout selection options in # various orders of priority. # # Returns a *list* containing: (the resultant symbolic ref/or SHA1,'branch' or # 'tag' (to determine if something like git-pull would be suitable or whether # you have a detached HEAD)). Since the sym-ref is returned first that should # be what you get in a scalar context, if that's all you want. sub _determinePreferredCheckoutSource { my ($self, $module) = @_; $module //= $self->module(); my @priorityOrderedSources = ( # option-name type getOption-inheritance-flag [qw(commit tag module)], [qw(revision tag module)], [qw(tag tag module)], [qw(branch branch module)], [qw(branch-group branch module)], [qw(use-stable-kde branch module)], # commit/rev/tag don't make sense for git as globals [qw(branch branch allow-inherit)], [qw(branch-group branch allow-inherit)], [qw(use-stable-kde branch allow-inherit)], ); # For modules that are not actually a 'proj' module we skip branch-group # and use-stable-kde entirely to allow for global/module branch selection # options to be selected... kind of complicated, but more DWIMy if (!$module->scm()->isa('ksb::Updater::KDEProject')) { @priorityOrderedSources = grep { $_->[0] ne 'branch-group' && $_->[0] ne 'use-stable-kde' } @priorityOrderedSources; } my $checkoutSource; # Sorry about the !!, easiest way to be clear that bool context is intended my $sourceTypeRef = first { !!($checkoutSource = ($module->getOption($_->[0], $_->[2]) // '')) } @priorityOrderedSources; if (!$sourceTypeRef) { return qw(master branch); } # One fixup is needed for use-stable-kde, to pull the actual branch name # from the right spot. Although if no branch name is set we use master, # without trying to search again. if ($sourceTypeRef->[0] eq 'use-stable-kde') { $checkoutSource = $module->getOption('#branch:stable', 'module') || 'master'; } # Likewise branch-group requires special handling. checkoutSource is # currently the branch-group to be resolved. if ($sourceTypeRef->[0] eq 'branch-group') { assert_isa($self, 'ksb::Updater::KDEProject'); $checkoutSource = $self->_resolveBranchGroup($checkoutSource); if (!$checkoutSource) { my $branchGroup = $module->getOption('branch-group'); whisper ("No specific branch set for $module and $branchGroup, using master!"); $checkoutSource = 'master'; } } if ($sourceTypeRef->[0] eq 'tag' && $checkoutSource !~ m{^refs/tags/}) { $checkoutSource = "refs/tags/$checkoutSource"; } return ($checkoutSource, $sourceTypeRef->[1]); } # Tries to check whether the git module is using submodules or not. Currently # we just check the .git/config file (using git-config) to determine whether # there are any 'active' submodules. # # MUST BE RUN FROM THE SOURCE DIR sub _hasSubmodules { # The git-config line shows all option names of the form submodule.foo.active, # filtering down to options for which the option is set to 'true' my @configLines = filter_program_output(undef, # accept all lines qw(git config --local --get-regexp ^submodule\..*\.active true)); return scalar @configLines > 0; } # Splits a URI up into its component parts. Taken from # http://search.cpan.org/~ether/URI-1.67/lib/URI.pm # Copyright Gisle Aas under the following terms: # "This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself." sub _splitUri { my($scheme, $authority, $path, $query, $fragment) = $_[0] =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; return ($scheme, $authority, $path, $query, $fragment); } # This stashes existing changes if necessary, and then runs a provided # update routine in order to advance the given module to the desired head. # Finally, if changes were stashed, they are applied and the stash stack is # popped. # # It is assumed that the required remote has been setup already, that we # are on the right branch, and that we are already in the correct # directory. # # First parameter is a reference to the subroutine to run. This subroutine # should need no parameters and return a boolean success indicator. It may # throw exceptions. # # Throws an exception on error. # # No return value. sub stashAndUpdate { my $self = assert_isa(shift, 'ksb::Updater::Git'); my $updateSub = shift; my $module = $self->module(); my $date = strftime ("%F-%R", gmtime()); # ISO Date, hh:mm time # To find out if we should stash, we use git-diff-index which # is intended to be scriptable and returns information on both the index # and the working dir in one command. my $status = 1; my $needsStash = !pretending() && (system('git', 'diff-index', '--quiet', 'HEAD') >> 8); log_command($module, 'git-status-before-update', [qw(git status)]); if ($needsStash) { info ("\tLocal changes detected, stashing them away..."); $status = log_command($module, 'git-stash-save', [ qw(git stash save --quiet), "kdesrc-build auto-stash at $date", ]); if ($status != 0) { log_command($module, 'git-status-after-error', [qw(git status)]); croak_runtime("Unable to stash local changes for $module, aborting update."); } } if (!$updateSub->()) { error ("\tUnable to update the source code for r[b[$module]"); log_command($module, 'git-status-after-error', [qw(git status)]); return; } # Update is performed and successful, re-apply the stashed changes if ($needsStash) { info ("\tModule updated, reapplying your local changes."); log_command($module, 'git-status-before-stash-pop', [qw(git status)]); $status = log_command($module, 'git-stash-pop', [ qw(git stash pop --index --quiet) ]); if ($status != 0) { error (<module(); my $configuredUrl = $module->getOption('repository'); my @outputs; # The Repo URL isn't much good, let's find a remote name to use it with. # We'd have to escape the repo URL to pass it to Git, which I don't trust, # so we just look for all remotes and make sure the URL matches afterwards. eval { @outputs = slurp_git_config_output( qw/git config --null --get-regexp remote\..*\.url ./ ); }; if ($@) { error ("\tUnable to run git config, is there a setup error?"); return; } my @results; foreach my $output (@outputs) { # git config output between key/val is divided by newline. my ($remoteName, $url) = split(/\n/, $output); $remoteName =~ s/^remote\.//; $remoteName =~ s/\.url$//; # remove the cruft # Skip other remotes next unless $self->_isPlausibleExistingRemote($remoteName, $url, $configuredUrl); # Try to avoid "weird" remote names. next if $remoteName !~ /^[\w-]*$/; # A winner is this one. push @results, $remoteName; } return @results; } # Generates a potential new branch name for the case where we have to setup # a new remote-tracking branch for a repository/branch. There are several # criteria that go into this: # * The local branch name will be equal to the remote branch name to match usual # Git convention. # * The name chosen must not already exist. This methods tests for that. # * The repo name chosen should be (ideally) a remote name that the user has # added. If not, we'll try to autogenerate a repo name (but not add a # remote!) based on the repository.git part of the URI. # # As with nearly all git support functions, we should be running in the # source directory of the git module. Don't call this function unless # you've already checked that a suitable remote-tracking branch doesn't # exist. # # First parameter: The name of a git remote to use. # Second parameter: The name of the remote head we need to make a branch name # of. # Returns: A useful branch name that doesn't already exist, or '' if no # name can be generated. sub makeBranchname { my $self = assert_isa(shift, 'ksb::Updater::Git'); my $remoteName = shift || 'origin'; my $branch = shift; my $module = $self->module(); my $chosenName; # Use "$branch" directly if not already used, otherwise try to prefix # with the remote name. for my $possibleBranch ($branch, "$remoteName-$branch", "ksdc-$remoteName-$branch") { my $result = system('git', 'show-ref', '--quiet', '--verify', '--', "refs/heads/$possibleBranch") >> 8; return $possibleBranch if $result == 1; } croak_runtime("Unable to find good branch name for $module branch name $branch"); } # Returns the number of lines in the output of the given command. The command # and all required arguments should be passed as a normal list, and the current # directory should already be set as appropriate. # # Return value is the number of lines of output. # Exceptions are raised if the command could not be run. sub count_command_output { # Don't call with $self->, all args are passed to filter_program_output my @args = @_; my $count = 0; filter_program_output(sub { $count++ if $_ }, @args); return $count; } # A simple wrapper that is used to split the output of 'git config --null' # correctly. All parameters are then passed to filter_program_output (so look # there for help on usage). sub slurp_git_config_output { # Don't call with $self->, all args are passed to filter_program_output local $/ = "\000"; # Split on null # This gets rid of the trailing nulls for single-line output. (chomp uses # $/ instead of hardcoding newline chomp(my @output = filter_program_output(undef, @_)); # No filter return @output; } # Returns true if the git module in the current directory has a remote of the # name given by the first parameter. sub hasRemote { my ($self, $remote) = @_; my $hasRemote = 0; eval { filter_program_output(sub { $hasRemote ||= ($_ && /^$remote/) }, 'git', 'remote'); }; return $hasRemote; } # Subroutine to add the 'kde:' alias to the user's git config if it's not # already set. # # Call this as a static class function, not as an object method # (i.e. ksb::Updater::Git::verifyGitConfig, not $foo->verifyGitConfig) # # Returns false on failure of any sort, true otherwise. sub verifyGitConfig { my $contextOptions = shift; my $useInvent = $contextOptions->getOption('x-invent-kde-push-urls'); my $protocol = $contextOptions->getOption('git-desired-protocol') || 'git'; my $pushUrlPrefix = 'git@git.kde.org:'; if ($useInvent) { if ($protocol eq 'git' || $protocol eq 'https') { $pushUrlPrefix = $protocol eq 'git' ? 'git@invent.kde.org:' : 'https://invent.kde.org/'; } else { error(" b[y[*] Invalid b[git-desired-protocol] $protocol"); error(" b[y[*] Try setting this option to 'git' if you're not using a proxy"); croak_runtime("Invalid git-desired-protocol: $protocol"); } } my $configOutput = qx'git config --global --get url.https://anongit.kde.org/.insteadOf kde:'; # 0 means no error, 1 means no such section exists -- which is OK if ((my $errNum = $? >> 8) >= 2) { my $error = "Code $errNum"; my %errors = ( 3 => 'Invalid config file (~/.gitconfig)', 4 => 'Could not write to ~/.gitconfig', 2 => 'No section was provided to git-config', 1 => 'Invalid section or key', 5 => 'Tried to set option that had no (or multiple) values', 6 => 'Invalid regexp with git-config', 128 => 'HOME environment variable is not set (?)', ); $error = $errors{$errNum} if exists $errors{$errNum}; error (" r[*] Unable to run b[git] command:\n\t$error"); return 0; } # If we make it here, I'm just going to assume git works from here on out # on this simple task. if ($configOutput !~ /^kde:\s*$/) { whisper ("\tAdding git download kde: alias"); my $result = safe_system( - qw(git config --global --add url.https://anongit.kde.org/.insteadOf kde:) + qw(git config --global --add url.https://invent.kde.org/.insteadOf kde:) ) >> 8; return 0 if $result != 0; } $configOutput = qx"git config --global --get url.$pushUrlPrefix.pushInsteadOf kde:"; if ($configOutput !~ /^kde:\s*$/) { whisper ("\tAdding git upload kde: alias"); my $result = safe_system("git config --global --add url.$pushUrlPrefix.pushInsteadOf kde:") >> 8; return 0 if $result != 0; } # Remove old kdesrc-build installed aliases (kde: -> git://anongit.kde.org/) $configOutput = qx'git config --global --get url.git://anongit.kde.org/.insteadOf kde:'; if ($configOutput =~ /^kde:\s*$/) { whisper ("\tRemoving outdated kde: alias"); my $result = safe_system( qw(git config --global --unset-all url.git://anongit.kde.org/.insteadOf kde:) ) >> 8; return 0 if $result != 0; } if ($useInvent) { $configOutput = qx'git config --global --get url.git@git.kde.org:.pushInsteadOf kde:'; if ($configOutput =~ /^kde:\s*$/) { whisper ("\tRemoving outdated kde: alias"); my $result = safe_system( qw(git config --global --unset-all url.git@git.kde.org:.pushInsteadOf kde:) ) >> 8; return 0 if $result != 0; } } return 1; } 1;