Having this stuff in a separate module is a remnant of the time when hydra-server could add builds to the queue directly. This is no longer the case.
VU2OLHD246DFWL2WPFSKWPLXTN3WRL25TSRU4PJMJBNWDF35OFRAC MSDSOL5L3RDRKUPTSX5MKYBUJM6HUU5Y57VW2RXKHOZWJY2KXXUAC ZTQ5WWHD2BR44AVVHMCCRK44XFBO4HRCFNF2ZOGQDL7R4DI5P6MAC E3IEH57UPWDTOUGXLQTWE2OGAXLVXBGBTT5FLSF6UHRJ5Q2QFUVQC GREPCKGI6YY72RRGF4UBHRMXIWX2YAPPMYXZDVTNG3P37WR6CRVQC 5KWIPCUK733Q6IL6YSGFJGPUFTPGIVWC7JYEYHH2CRGJUGPKDDBQC O2BEFBIOK5JTQBXSHWZXKSEU5VQY5REGDVXPDO6N2JWS4OVUBNEAC GXKMNJ26ACZUBYZB6CFHCH3UAY2BQLFBJUVG6ZAPO6EBK7VVOMLAC BGDZAEU7KDMQZLSZXCFBY6GLNX37K2TXGOX65JAZSAEK6XMFEBXAC KLFSX2R62HLE3GWQNVFUAXSRZWDTLRXOCNJTVCKEDRJVO7TTEMQQC 5TZGO7RJZMEW4FETE2SVA6LVYD2TJWXJC2ENZ63QEFWZ77OXQJKQC 53IMJNBB3E2W34UXZFNNZUGPW3FU4LRQRQAEHQTOHHY6DVE2VJRAC I6QMKSIS7HFBPONWWSGXX2IIHEYHEPA4QU2SSM6QUTDK5NKK3VXQC DKIA7GAD5ZV7BHEAFQVUEKNNP32LVE5OLDRA6TIY4G7JGUN5ID2QC NY77R3JJCEHMCUVKWJD3R75KKQHQHXTQIJMW6SVW7OABRSXOJZOAC MPFSVI5XLGXVPJP5OJXMT7CF2SFFFFT6R36O74MJB5TF6474E54AC BKOIYITRBRVU4D7XFAZPV5QHAPCBMIO3SBNHYJ6TVT43WR32CTHQC SHYRGAWZFYGRWCRB54TYL2GTU3B4WMQ3J5H4ZHGV27W7PUQN3EWQC ZWCTAZGLJZQNTYWTC2XQUKMILJF6JGDL5IND6QNYWK4FIGMLRFXAC SGNXIOI4SO56F4YCGVMGZZO3AYXGPDL4FL75RDXAK5Y22IYWPPAQC LBNVQXUBEZ45SOTGVXK5UEZXIAIZTJLWZNUYFI4JZ6J65N3KPDVQC OOQ2D3KCLFPYNAN253PHWLBQMB6OMO2KYQWQXLTP65SQAYZWQ5LAC IMQRX4MPANNOXDP6THT2FA4576CDFY44LGNCS74BHV6DWLOCXQOQC 3XTHEUMP2ZOMPQWE3S5QWHIHCEJNEXGDPQB3JUVZFPS3RFMY455QC BMSQD2ZH3T37RNPRKKKNF5DTJEGBLY4YR2BZDKP7PXJGS3ZBBLWAC JAH3UPWAVSHXIPNGL6PROQPZBYZHPJNFONWBDZX4HCX646USZXUQC 6WRGCITDYP7JIBYP25QIWCHWRJWFPDP2D3TJS3WO3KUHQQJAWHMQC JZE7DC2FYU4TAGBTMZLXFTISJZ2FTCBLGUDUBKGH4UUIWXRIS3VAC IEXUBVNBCEKP5RIP3F4UWX3XNVUQY2CE3BBODXIYW5KFJH73D6JQC CPMIKBDTO6W43VNQDIGIC44HGXQGTPG3VFI3R5QYIAYRNNKYU6KAC KQS7DSKJHTEHALCPTXMWRX2IBOVC5BWU7RWJ4GP5A2JJSBR7HPKAC JTRG7RDQXKPSO4ESGDLSVAT5WIFGKDL424MN6YYCVTKCOR2FTXRQC 2WRTOU2Z2R3MWLRZCKK3ZZ2C5LJBH6GNJT77NETVA22Y23DUIX5QC X5EOJLNADHHVONNRJIR4XE3X2TKQAJRBVAUKR3SCG4PLQDAZYCQQC SS4TZXNUWXSEJC3XYHGVS3IBZ2D7GPIPELODVQOHRRGYADI2L72AC Y6FFX4YBH2APZUWPFFQ4VJZ4A7PMMK256X66FI77DDGQOFQDF6ZAC HPEG2RHVNHOPB5T4ZRXANIRBMVOVY3B5GFETJRYOTDJFVAYH2TQAC H3S3H752PLJEI7LXA5TGUY5DFD5SRIPTIKWY5WGY6B4OLQRVKTWAC INNOEHO6CTW75YEEGNLUKISQEMOAE4P2C2SEVHEKOVIFHADWY4OAC D3YETHSBG7TMJWB5VD2KDU6TXZZ2FG44MNKZRQFR5W3JAXCSJGGQC PMNWRTGJ4GVSMSSAWSUD57B26PCRAHMZIQ5SIWJIK7A74ENKEQLAC 6GJSWZ4F22OSRY4YVNGTVZC4Y6DX3KMG5J5V3DLDGNHWZ3BZW37AC YFPZ46YK4BOI6VH2H3F757UEGEYONURUAEDAYEIBLRY33PLSSO4AC Z52T2BC4CTXQGBXPW4VZF5A5W67KDJ65RUBCM7MWHUNPMI6XLQCQC 4FWDVNWAUAFDXPXIOBOVM2ZRPZG4LLE4JBKYIXUKR45YN6MEOMXQC HE3GX5IPS6XA7KLNP5WZY2YU27WQS663WSKAL5FHWBSJ5GMM633AC K3HODXGHZ47WWSTEKUFCAPRJYCM564XF6YVE2QM37HPR5RQMFCWQC KHYZVPBRZSCFT4U3JTUKGTNJ4LO3J7JJY6I5CRKFZOQ337VBAZLAC P5XCKTFDQHOWNE5ZLPFH27FYZQ7QPCEL33FYR4LTI2JR3IA2ILOAC PGSSRA7CPOQI354Y6YJTYRFF57YJARB5THFE3MBJBVHOLYNEIGTQC FXW2UR7FY7NPCEHSCAO4FTZHA47K5YACKHJJVKP6T3V42LJJTLAAC A43SLRSH6OIIEZWLRKLMERX7HOMBICKG7WHELCZYLOJWZ3JFRV2AC QMW24O5S43MYF5ZTBULUEZNDW2FKJ3QP2GL46P6B2SVGSQLVEACAC CQTN62OHT4DY35E2MJEG7GFTVNEE5KRDMV6ASBQLBHN7BUDK7WHAC 4OXJRURP72HUQUOE3DQZEYG523FC67A2AMNBO6GSWKKUQINAKCHAC SM5M2J3AGBS4IHD7TBFBVNMXTUBVA5OIFIIJJDAU6KUCPRU4S74AC MRJCQ4EO525TGAZFHIHPXH3WHNH3BFPEO2XBZTJ7EJJZHNP7EV5AC CHQEG6WY44VSOTLNH5KDZWJCCHNHRUCX6BEREXUUO56VOKHNSUZAC ARD6Z67TDHK2XMW47CSVOXXF327YGOMYK3EAXTSVVXNDAFQYNO5AC WVD3YYON22ES6LFQTX7LYBXTEBERGIN2DHOJC6M36UJ4KS4IHS2QC 5GPK54IVSFG4NBNGVJBPBTNBSLKSNGKIYN5CIO4YEHH6GKFD2RYAC RXVJFQ5AV3WME4HDVBPSRCALQTXROT4KQPOQVO6KTWTBNZIZZGPAC DDMYFZ5XWW6O3TGCVNW4GPVR2ZPRFWIPQU54DCVUYARFXIMKENUQC FM4O2L4MNPCHWRDRHKGKSH5TFFX6R2RMCPEQ3XCECA6UVLJPLUVQC FTPCV25MOLQUNR5CAR453W7T7QTUZRLPLEOSDZ5HSDFAXQZVHOYQC PHNLYPKB5SJJAHAICS6QEMRNCREPG7SC2MQRLTQMQLWGXM427S3QC JOYONH2KARKK2Z72WQW6DZ4B6WT47Z4VHOHGL7KM3B6RT3CBAMLQC QS4OX6Z7OC46ZBRSEGQQAVKIMXRHDDRXS32EJI6DGN37AXH23K3QC DVLDHOUZ6QHPEIKXZJMZFHWOHZZG2H72MEGULQOKGGHELTK6PW4AC JCJJKRWQN7XLV65FQEW4YBGI24IP6PFILISCMDWPXT7YEMEMDUAAC A22P7HCOGNO3XEQWBNEG2VHTGUB2GKQ75Q6JDMPQNQCLFHE7XBFAC ZTQEU5QSAJYC66QQABJLVR7EEZWEIW6UMQMSIEP2KRZH5PGEB53QC 24BMQDZAWDQ7VNIA7TIROXSOYLOJBNZ2E4264WHWNJAEN6ZB3UOAC JYZEGF56TNCAHDNQNPCDMXZ4M3N57ADBLE4VH47DDJLLHQWL6BHQC MOX7XJ2E3XISXA7V7T4W6GEAGECGWBZ4PYSLTYBVVR4VAKOI33CQC OSVLMLCQQ52E47CX7TZAIFZSO4VVGRHWJTZY2G23YUPMDCKURTYAC AFTXA575C6JTVLVXTYJUKQGPLBO3NFORLO5XDSPHNL44HXLRH4TAC 2GK5DOU7ODF4WBSN3QTD3WIO52VTL2LOAXKGCDEMMAQPTEO4A4HAC AKRVETP5YMH3O36HFKUP7BHF2Q3Y3HMVYYG2N75JMRJVF5HVVYNAC JK2QWPH6EOQXGCADV7C5HSYRVWC5M53LAKVN26EMTLY65IKU3AEQC N22GPKYTOLZLBGTGDATQDVZ4R5APZEAOIA7L32X4UXBH4XNI7MWAC RX5IIZMT7AKE3SME2TON6HWE7BB2GNYV3KOKL3GLH4J7J2GEOO5AC TJK27WSBFOM6LKVCSA7LTTCWUGB4O2AL22PNIDQXS4BFOFCISH2QC 5SHCWE7XPQORSOLY7HGAIK2ODKBFPY4KVXRL2W7X6D4WALU544HQC ZDENAYQI5DRRNUIDVKUGC45NK6C4ZFUL5FYMACTRZOCYQXPMY63QC NS7SND6RF6X3CVSVP7MLAQQZFA64E63YKFFABPEAGEPHX6PNWBOQC RFE6T5LGBFFNEPHZOPF4UNMFC2L4CGD5TPAMOXDLRPH3TZJ43UBAC POPU2ATH2HHBTGHKRAV3EY2K55P664IARI3YJGLDKVJ6PQPXBQ4AC 5SMQ2PLKIUCWCHY2LZIKI4SRZYKKMZKWZR5QSKE6ZM22HPRH54EQC FAIJDQKZH6SUUNCKW5RIOZ37YRAO5ACS6FX76MHRNN53LDBWO6ZQC HX4QYOYAKKFKK4KF6SZ6FQCM5ZF7ZFDTQUR4GS5WPPTYZASYZZUAC sub parseJobName {# Parse a job specification of the form `<project>:<jobset>:<job># [attrs]'. The project, jobset and attrs may be omitted. The# attrs have the form `name = "value"'.my ($s) = @_;our $key;our %attrs = ();# hm, maybe I should stop programming Perl before it's too late...$s =~ / ^ (?: (?: ($projectNameRE) : )? ($jobsetNameRE) : )? ($jobNameRE) \s*(\[ \s* (([\w]+) (?{ $key = $^N; }) \s* = \s* \"([\w\-]+) (?{ $attrs{$key} = $^N; }) \"\s* )* \])? $/xor die "invalid job specifier `$s'";return ($1, $2, $3, \%attrs);}sub attrsToSQL {my ($attrs, $id) = @_;my $query = "1 = 1";foreach my $name (keys %{$attrs}) {my $value = $attrs->{$name};$name =~ /^[\w\-]+$/ or die;$value =~ /^[\w\-]+$/ or die;# !!! Yes, this is horribly injection-prone... (though# name/value are filtered above). Should use SQL::Abstract,# but it can't deal with subqueries. At least we should use# placeholders.$query .= " and exists (select 1 from buildinputs where build = $id and name = '$name' and value = '$value')";}return $query;}sub fetchInputBuild {my ($db, $project, $jobset, $name, $value) = @_;my $prevBuild;if ($value =~ /^\d+$/) {$prevBuild = $db->resultset('Builds')->find({ id => int($value) });} else {my ($projectName, $jobsetName, $jobName, $attrs) = parseJobName($value);$projectName ||= $project->name;$jobsetName ||= $jobset->name;# Pick the most recent successful build of the specified job.$prevBuild = $db->resultset('Builds')->search({ finished => 1, project => $projectName, jobset => $jobsetName, job => $jobName, buildStatus => 0 },{ order_by => "me.id DESC", rows => 1, where => \ attrsToSQL($attrs, "me.id") })->single;}return () if !defined $prevBuild || !isValidPath(getMainOutput($prevBuild)->path);#print STDERR "input `", $name, "': using build ", $prevBuild->id, "\n";my $pkgNameRE = "(?:(?:[A-Za-z0-9]|(?:-[^0-9]))+)";my $versionRE = "(?:[A-Za-z0-9\.\-]+)";my $relName = ($prevBuild->releasename or $prevBuild->nixname);my $version = $2 if $relName =~ /^($pkgNameRE)-($versionRE)$/;my $mainOutput = getMainOutput($prevBuild);my $result ={ storePath => $mainOutput->path, id => $prevBuild->id, version => $version, outputName => $mainOutput->name};if (isValidPath($prevBuild->drvpath)) {$result->{drvPath} = $prevBuild->drvpath;}return $result;}sub fetchInputSystemBuild {my ($db, $project, $jobset, $name, $value) = @_;my ($projectName, $jobsetName, $jobName, $attrs) = parseJobName($value);$projectName ||= $project->name;$jobsetName ||= $jobset->name;my @latestBuilds = $db->resultset('LatestSucceededForJob')->search({}, {bind => [$projectName, $jobsetName, $jobName]});my @validBuilds = ();foreach my $build (@latestBuilds) {push(@validBuilds, $build) if isValidPath(getMainOutput($build)->path);}
my @inputs = ();foreach my $prevBuild (@validBuilds) {my $pkgNameRE = "(?:(?:[A-Za-z0-9]|(?:-[^0-9]))+)";my $versionRE = "(?:[A-Za-z0-9\.\-]+)";my $relName = ($prevBuild->releasename or $prevBuild->nixname);my $version = $2 if $relName =~ /^($pkgNameRE)-($versionRE)$/;my $input ={ storePath => getMainOutput($prevBuild)->path, id => $prevBuild->id, version => $version, system => $prevBuild->system};push(@inputs, $input);}return @inputs;}sub fetchInputEval {my ($db, $project, $jobset, $name, $value) = @_;my $eval;if ($value =~ /^\d+$/) {$eval = $db->resultset('JobsetEvals')->find({ id => int($value) });die "evaluation $eval->{id} does not exist\n" unless defined $eval;} elsif ($value =~ /^($projectNameRE):($jobsetNameRE)$/) {my $jobset = $db->resultset('Jobsets')->find({ project => $1, name => $2 });die "jobset ‘$value’ does not exist\n" unless defined $jobset;$eval = getLatestFinishedEval($jobset);die "jobset ‘$value’ does not have a finished evaluation\n" unless defined $eval;} elsif ($value =~ /^($projectNameRE):($jobsetNameRE):($jobNameRE)$/) {$eval = $db->resultset('JobsetEvals')->find({ project => $1, jobset => $2, hasnewbuilds => 1 },{ order_by => "id DESC", rows => 1, where =>\ [ # All builds in this jobset should be finished..."not exists (select 1 from JobsetEvalMembers m join Builds b on m.build = b.id where m.eval = me.id and b.finished = 0) "# ...and the specified build must have succeeded.. "and exists (select 1 from JobsetEvalMembers m join Builds b on m.build = b.id where m.eval = me.id and b.job = ? and b.buildstatus = 0)", [ 'name', $3 ] ]});die "there is no successful build of ‘$value’ in a finished evaluation\n" unless defined $eval;} else {die;}my $jobs = {};foreach my $build ($eval->builds) {next unless $build->finished == 1 && $build->buildstatus == 0;# FIXME: Handle multiple outputs.my $out = $build->buildoutputs->find({ name => "out" });next unless defined $out;# FIXME: Should we fail if the path is not valid?next unless isValidPath($out->path);$jobs->{$build->get_column('job')} = $out->path;}return { jobs => $jobs };}sub fetchInput {my ($plugins, $db, $project, $jobset, $name, $type, $value, $emailresponsible) = @_;my @inputs;if ($type eq "build") {@inputs = fetchInputBuild($db, $project, $jobset, $name, $value);}elsif ($type eq "sysbuild") {@inputs = fetchInputSystemBuild($db, $project, $jobset, $name, $value);}elsif ($type eq "eval") {@inputs = fetchInputEval($db, $project, $jobset, $name, $value);}elsif ($type eq "string" || $type eq "nix") {die unless defined $value;@inputs = { value => $value };}elsif ($type eq "boolean") {die unless defined $value && ($value eq "true" || $value eq "false");@inputs = { value => $value };}else {my $found = 0;foreach my $plugin (@{$plugins}) {@inputs = $plugin->fetchInput($type, $name, $value, $project, $jobset);if (defined $inputs[0]) {$found = 1;last;}}die "input `$name' has unknown type `$type'." unless $found;}foreach my $input (@inputs) {$input->{type} = $type;$input->{emailresponsible} = $emailresponsible;}return @inputs;}sub booleanToString {my ($exprType, $value) = @_;my $result;if ($exprType eq "guile") {if ($value eq "true") {$result = "#t";} else {$result = "#f";}$result = $value;} else {$result = $value;}return $result;}sub buildInputToString {my ($exprType, $input) = @_;my $result;if ($exprType eq "guile") {$result = "'((file-name . \"" . ${input}->{storePath} . "\")" .(defined $input->{revision} ? "(revision . \"" . $input->{revision} . "\")" : "") .(defined $input->{revCount} ? "(revision-count . " . $input->{revCount} . ")" : "") .(defined $input->{gitTag} ? "(git-tag . \"" . $input->{gitTag} . "\")" : "") .(defined $input->{shortRev} ? "(short-revision . \"" . $input->{shortRev} . "\")" : "") .(defined $input->{version} ? "(version . \"" . $input->{version} . "\")" : "") .")";} else {$result = "{ outPath = builtins.storePath " . $input->{storePath} . "" ."; inputType = \"" . $input->{type} . "\"" .(defined $input->{uri} ? "; uri = \"" . $input->{uri} . "\"" : "") .(defined $input->{revNumber} ? "; rev = " . $input->{revNumber} . "" : "") .(defined $input->{revision} ? "; rev = \"" . $input->{revision} . "\"" : "") .(defined $input->{revCount} ? "; revCount = " . $input->{revCount} . "" : "") .(defined $input->{gitTag} ? "; gitTag = \"" . $input->{gitTag} . "\"" : "") .(defined $input->{shortRev} ? "; shortRev = \"" . $input->{shortRev} . "\"" : "") .(defined $input->{version} ? "; version = \"" . $input->{version} . "\"" : "") .(defined $input->{outputName} ? "; outputName = \"" . $input->{outputName} . "\"" : "") .(defined $input->{drvPath} ? "; drvPath = builtins.storePath " . $input->{drvPath} . "" : "") .";}";}return $result;}sub inputsToArgs {my ($inputInfo, $exprType) = @_;my @res = ();foreach my $input (sort keys %{$inputInfo}) {push @res, "-I", "$input=$inputInfo->{$input}->[0]->{storePath}"if scalar @{$inputInfo->{$input}} == 1&& defined $inputInfo->{$input}->[0]->{storePath};foreach my $alt (@{$inputInfo->{$input}}) {if ($alt->{type} eq "string") {push @res, "--argstr", $input, $alt->{value};}elsif ($alt->{type} eq "boolean") {push @res, "--arg", $input, booleanToString($exprType, $alt->{value});}elsif ($alt->{type} eq "nix") {die "input type ‘nix’ only supported for Nix-based jobsets\n" unless $exprType eq "nix";push @res, "--arg", $input, $alt->{value};}elsif ($alt->{type} eq "eval") {die "input type ‘eval’ only supported for Nix-based jobsets\n" unless $exprType eq "nix";my $s = "{ ";# FIXME: escape $_. But dots should not be escaped.$s .= "$_ = builtins.storePath ${\$alt->{jobs}->{$_}}; "foreach keys %{$alt->{jobs}};$s .= "}";push @res, "--arg", $input, $s;}else {push @res, "--arg", $input, buildInputToString($exprType, $alt);}}}return @res;}sub evalJobs {my ($inputInfo, $exprType, $nixExprInputName, $nixExprPath) = @_;my $nixExprInput = $inputInfo->{$nixExprInputName}->[0]or die "cannot find the input containing the job expression\n";die "multiple alternatives for the input containing the Nix expression are not supported.\n"if scalar @{$inputInfo->{$nixExprInputName}} != 1;my $nixExprFullPath = $nixExprInput->{storePath} . "/" . $nixExprPath;my $evaluator = ($exprType eq "guile") ? "hydra-eval-guile-jobs" : "hydra-eval-jobs";my @cmd = ($evaluator, $nixExprFullPath, "--gc-roots-dir", getGCRootsDir, "-j", 1, inputsToArgs($inputInfo, $exprType));if (defined $ENV{'HYDRA_DEBUG'}) {sub escape {my $s = $_;$s =~ s/'/'\\''/g;return "'" . $s . "'";}my @escaped = map escape, @cmd;print STDERR "evaluator: @escaped\n";}(my $res, my $jobsJSON, my $stderr) = captureStdoutStderr(21600, @cmd);die "$evaluator returned " . ($res & 127 ? "signal $res" : "exit code " . ($res >> 8)). ":\n" . ($stderr ? decode("utf-8", $stderr) : "(no output)\n")if $res;print STDERR "$stderr";return (decode_json($jobsJSON), $nixExprInput);}# Return the most recent evaluation of the given jobset (that# optionally had new builds), or undefined if no such evaluation# exists.sub getPrevJobsetEval {my ($db, $jobset, $hasNewBuilds) = @_;my ($prevEval) = $jobset->jobsetevals(($hasNewBuilds ? { hasnewbuilds => 1 } : { }),{ order_by => "id DESC", rows => 1 });return $prevEval;}# Check whether to add the build described by $buildInfo.sub checkBuild {my ($db, $jobset, $inputInfo, $nixExprInput, $buildInfo, $buildMap, $prevEval, $jobOutPathMap, $plugins) = @_;my @outputNames = sort keys %{$buildInfo->{outputs}};die unless scalar @outputNames;# In various checks we can use an arbitrary output (the first)# rather than all outputs, since if one output is the same, the# others will be as well.my $firstOutputName = $outputNames[0];my $firstOutputPath = $buildInfo->{outputs}->{$firstOutputName};my $jobName = $buildInfo->{jobName} or die;my $drvPath = $buildInfo->{drvPath} or die;my $build;txn_do($db, sub {my $job = $jobset->jobs->update_or_create({ name => $jobName });# Don't add a build that has already been scheduled for this# job, or has been built but is still a "current" build for# this job. Note that this means that if the sources of a job# are changed from A to B and then reverted to A, three builds# will be performed (though the last one will probably use the# cached result from the first). This ensures that the builds# with the highest ID will always be the ones that we want in# the channels. FIXME: Checking the output paths doesn't take# meta-attributes into account. For instance, do we want a# new build to be scheduled if the meta.maintainers field is# changed?if (defined $prevEval) {# Only check one output: if it's the same, the other will be as well.my $firstOutput = $outputNames[0];my ($prevBuild) = $prevEval->builds->search(# The "project" and "jobset" constraints are# semantically unnecessary (because they're implied by# the eval), but they give a factor 1000 speedup on# the Nixpkgs jobset with PostgreSQL.{ project => $jobset->project->name, jobset => $jobset->name, job => $jobName,name => $firstOutputName, path => $firstOutputPath },{ rows => 1, columns => ['id'], join => ['buildoutputs'] });if (defined $prevBuild) {#print STDERR " already scheduled/built as build ", $prevBuild->id, "\n";$buildMap->{$prevBuild->id} = { id => $prevBuild->id, jobName => $jobName, new => 0, drvPath => $drvPath };return;}}# Prevent multiple builds with the same (job, outPath) from# being added.my $prev = $$jobOutPathMap{$jobName . "\t" . $firstOutputPath};if (defined $prev) {#print STDERR " already scheduled as build ", $prev, "\n";return;}my $time = time();sub null {my ($s) = @_;return $s eq "" ? undef : $s;}# Add the build to the database.$build = $job->builds->create({ timestamp => $time, description => null($buildInfo->{description}), license => null($buildInfo->{license}), homepage => null($buildInfo->{homepage}), maintainers => null($buildInfo->{maintainers}), maxsilent => $buildInfo->{maxSilent}, timeout => $buildInfo->{timeout}, nixname => $buildInfo->{nixName}, drvpath => $drvPath, system => $buildInfo->{system}, nixexprinput => $jobset->nixexprinput, nixexprpath => $jobset->nixexprpath, priority => $buildInfo->{schedulingPriority}, finished => 0, iscurrent => 1, ischannel => $buildInfo->{isChannel}});$build->buildoutputs->create({ name => $_, path => $buildInfo->{outputs}->{$_} })foreach @outputNames;$buildMap->{$build->id} = { id => $build->id, jobName => $jobName, new => 1, drvPath => $drvPath };$$jobOutPathMap{$jobName . "\t" . $firstOutputPath} = $build->id;print STDERR "added build ${\$build->id} (${\$jobset->project->name}:${\$jobset->name}:$jobName)\n";});return $build;};
use Hydra::Schema;use Hydra::Plugin;use Hydra::Helper::Nix;
use Config::General;use Data::Dump qw(dump);use Digest::SHA qw(sha256_hex);use Encode;use File::Slurp;
sub parseJobName {# Parse a job specification of the form `<project>:<jobset>:<job># [attrs]'. The project, jobset and attrs may be omitted. The# attrs have the form `name = "value"'.my ($s) = @_;our $key;our %attrs = ();# hm, maybe I should stop programming Perl before it's too late...$s =~ / ^ (?: (?: ($projectNameRE) : )? ($jobsetNameRE) : )? ($jobNameRE) \s*(\[ \s* (([\w]+) (?{ $key = $^N; }) \s* = \s* \"([\w\-]+) (?{ $attrs{$key} = $^N; }) \"\s* )* \])? $/xor die "invalid job specifier `$s'";return ($1, $2, $3, \%attrs);}sub attrsToSQL {my ($attrs, $id) = @_;my $query = "1 = 1";foreach my $name (keys %{$attrs}) {my $value = $attrs->{$name};$name =~ /^[\w\-]+$/ or die;$value =~ /^[\w\-]+$/ or die;# !!! Yes, this is horribly injection-prone... (though# name/value are filtered above). Should use SQL::Abstract,# but it can't deal with subqueries. At least we should use# placeholders.$query .= " and exists (select 1 from buildinputs where build = $id and name = '$name' and value = '$value')";}return $query;}sub fetchInputBuild {my ($db, $project, $jobset, $name, $value) = @_;my $prevBuild;if ($value =~ /^\d+$/) {$prevBuild = $db->resultset('Builds')->find({ id => int($value) });} else {my ($projectName, $jobsetName, $jobName, $attrs) = parseJobName($value);$projectName ||= $project->name;$jobsetName ||= $jobset->name;# Pick the most recent successful build of the specified job.$prevBuild = $db->resultset('Builds')->search({ finished => 1, project => $projectName, jobset => $jobsetName, job => $jobName, buildStatus => 0 },{ order_by => "me.id DESC", rows => 1, where => \ attrsToSQL($attrs, "me.id") })->single;}return () if !defined $prevBuild || !isValidPath(getMainOutput($prevBuild)->path);#print STDERR "input `", $name, "': using build ", $prevBuild->id, "\n";my $pkgNameRE = "(?:(?:[A-Za-z0-9]|(?:-[^0-9]))+)";my $versionRE = "(?:[A-Za-z0-9\.\-]+)";my $relName = ($prevBuild->releasename or $prevBuild->nixname);my $version = $2 if $relName =~ /^($pkgNameRE)-($versionRE)$/;my $mainOutput = getMainOutput($prevBuild);my $result ={ storePath => $mainOutput->path, id => $prevBuild->id, version => $version, outputName => $mainOutput->name};if (isValidPath($prevBuild->drvpath)) {$result->{drvPath} = $prevBuild->drvpath;}return $result;}sub fetchInputSystemBuild {my ($db, $project, $jobset, $name, $value) = @_;my ($projectName, $jobsetName, $jobName, $attrs) = parseJobName($value);$projectName ||= $project->name;$jobsetName ||= $jobset->name;my @latestBuilds = $db->resultset('LatestSucceededForJob')->search({}, {bind => [$projectName, $jobsetName, $jobName]});my @validBuilds = ();foreach my $build (@latestBuilds) {push(@validBuilds, $build) if isValidPath(getMainOutput($build)->path);}if (scalar(@validBuilds) == 0) {print STDERR "input `", $name, "': no previous build available\n";return ();}my @inputs = ();foreach my $prevBuild (@validBuilds) {my $pkgNameRE = "(?:(?:[A-Za-z0-9]|(?:-[^0-9]))+)";my $versionRE = "(?:[A-Za-z0-9\.\-]+)";my $relName = ($prevBuild->releasename or $prevBuild->nixname);my $version = $2 if $relName =~ /^($pkgNameRE)-($versionRE)$/;my $input ={ storePath => getMainOutput($prevBuild)->path, id => $prevBuild->id, version => $version, system => $prevBuild->system};push(@inputs, $input);}return @inputs;}sub fetchInputEval {my ($db, $project, $jobset, $name, $value) = @_;my $eval;if ($value =~ /^\d+$/) {$eval = $db->resultset('JobsetEvals')->find({ id => int($value) });die "evaluation $eval->{id} does not exist\n" unless defined $eval;} elsif ($value =~ /^($projectNameRE):($jobsetNameRE)$/) {my $jobset = $db->resultset('Jobsets')->find({ project => $1, name => $2 });die "jobset ‘$value’ does not exist\n" unless defined $jobset;$eval = getLatestFinishedEval($jobset);die "jobset ‘$value’ does not have a finished evaluation\n" unless defined $eval;} elsif ($value =~ /^($projectNameRE):($jobsetNameRE):($jobNameRE)$/) {$eval = $db->resultset('JobsetEvals')->find({ project => $1, jobset => $2, hasnewbuilds => 1 },{ order_by => "id DESC", rows => 1, where =>\ [ # All builds in this jobset should be finished..."not exists (select 1 from JobsetEvalMembers m join Builds b on m.build = b.id where m.eval = me.id and b.finished = 0) "# ...and the specified build must have succeeded.. "and exists (select 1 from JobsetEvalMembers m join Builds b on m.build = b.id where m.eval = me.id and b.job = ? and b.buildstatus = 0)", [ 'name', $3 ] ]});die "there is no successful build of ‘$value’ in a finished evaluation\n" unless defined $eval;} else {die;}my $jobs = {};foreach my $build ($eval->builds) {next unless $build->finished == 1 && $build->buildstatus == 0;# FIXME: Handle multiple outputs.my $out = $build->buildoutputs->find({ name => "out" });next unless defined $out;# FIXME: Should we fail if the path is not valid?next unless isValidPath($out->path);$jobs->{$build->get_column('job')} = $out->path;}return { jobs => $jobs };}sub fetchInput {my ($plugins, $db, $project, $jobset, $name, $type, $value, $emailresponsible) = @_;my @inputs;if ($type eq "build") {@inputs = fetchInputBuild($db, $project, $jobset, $name, $value);}elsif ($type eq "sysbuild") {@inputs = fetchInputSystemBuild($db, $project, $jobset, $name, $value);}elsif ($type eq "eval") {@inputs = fetchInputEval($db, $project, $jobset, $name, $value);}elsif ($type eq "string" || $type eq "nix") {die unless defined $value;@inputs = { value => $value };}elsif ($type eq "boolean") {die unless defined $value && ($value eq "true" || $value eq "false");@inputs = { value => $value };}else {my $found = 0;foreach my $plugin (@{$plugins}) {@inputs = $plugin->fetchInput($type, $name, $value, $project, $jobset);if (defined $inputs[0]) {$found = 1;last;}}die "input `$name' has unknown type `$type'." unless $found;}foreach my $input (@inputs) {$input->{type} = $type;$input->{emailresponsible} = $emailresponsible;}return @inputs;}sub booleanToString {my ($exprType, $value) = @_;my $result;if ($exprType eq "guile") {if ($value eq "true") {$result = "#t";} else {$result = "#f";}$result = $value;} else {$result = $value;}return $result;}sub buildInputToString {my ($exprType, $input) = @_;my $result;if ($exprType eq "guile") {$result = "'((file-name . \"" . ${input}->{storePath} . "\")" .(defined $input->{revision} ? "(revision . \"" . $input->{revision} . "\")" : "") .(defined $input->{revCount} ? "(revision-count . " . $input->{revCount} . ")" : "") .(defined $input->{gitTag} ? "(git-tag . \"" . $input->{gitTag} . "\")" : "") .(defined $input->{shortRev} ? "(short-revision . \"" . $input->{shortRev} . "\")" : "") .(defined $input->{version} ? "(version . \"" . $input->{version} . "\")" : "") .")";} else {$result = "{ outPath = builtins.storePath " . $input->{storePath} . "" ."; inputType = \"" . $input->{type} . "\"" .(defined $input->{uri} ? "; uri = \"" . $input->{uri} . "\"" : "") .(defined $input->{revNumber} ? "; rev = " . $input->{revNumber} . "" : "") .(defined $input->{revision} ? "; rev = \"" . $input->{revision} . "\"" : "") .(defined $input->{revCount} ? "; revCount = " . $input->{revCount} . "" : "") .(defined $input->{gitTag} ? "; gitTag = \"" . $input->{gitTag} . "\"" : "") .(defined $input->{shortRev} ? "; shortRev = \"" . $input->{shortRev} . "\"" : "") .(defined $input->{version} ? "; version = \"" . $input->{version} . "\"" : "") .(defined $input->{outputName} ? "; outputName = \"" . $input->{outputName} . "\"" : "") .(defined $input->{drvPath} ? "; drvPath = builtins.storePath " . $input->{drvPath} . "" : "") .";}";}return $result;}sub inputsToArgs {my ($inputInfo, $exprType) = @_;my @res = ();foreach my $input (sort keys %{$inputInfo}) {push @res, "-I", "$input=$inputInfo->{$input}->[0]->{storePath}"if scalar @{$inputInfo->{$input}} == 1&& defined $inputInfo->{$input}->[0]->{storePath};foreach my $alt (@{$inputInfo->{$input}}) {if ($alt->{type} eq "string") {push @res, "--argstr", $input, $alt->{value};}elsif ($alt->{type} eq "boolean") {push @res, "--arg", $input, booleanToString($exprType, $alt->{value});}elsif ($alt->{type} eq "nix") {die "input type ‘nix’ only supported for Nix-based jobsets\n" unless $exprType eq "nix";push @res, "--arg", $input, $alt->{value};}elsif ($alt->{type} eq "eval") {die "input type ‘eval’ only supported for Nix-based jobsets\n" unless $exprType eq "nix";my $s = "{ ";# FIXME: escape $_. But dots should not be escaped.$s .= "$_ = builtins.storePath ${\$alt->{jobs}->{$_}}; "foreach keys %{$alt->{jobs}};$s .= "}";push @res, "--arg", $input, $s;}else {push @res, "--arg", $input, buildInputToString($exprType, $alt);}}}return @res;}
my $nixExprInput = $inputInfo->{$nixExprInputName}->[0]or die "cannot find the input containing the job expression\n";die "multiple alternatives for the input containing the Nix expression are not supported.\n"if scalar @{$inputInfo->{$nixExprInputName}} != 1;my $nixExprFullPath = $nixExprInput->{storePath} . "/" . $nixExprPath;my $evaluator = ($exprType eq "guile") ? "hydra-eval-guile-jobs" : "hydra-eval-jobs";my @cmd = ($evaluator, $nixExprFullPath, "--gc-roots-dir", getGCRootsDir, "-j", 1, inputsToArgs($inputInfo, $exprType));if (defined $ENV{'HYDRA_DEBUG'}) {sub escape {my $s = $_;$s =~ s/'/'\\''/g;return "'" . $s . "'";}my @escaped = map escape, @cmd;print STDERR "evaluator: @escaped\n";}(my $res, my $jobsJSON, my $stderr) = captureStdoutStderr(21600, @cmd);die "$evaluator returned " . ($res & 127 ? "signal $res" : "exit code " . ($res >> 8)). ":\n" . ($stderr ? decode("utf-8", $stderr) : "(no output)\n")if $res;print STDERR "$stderr";return (decode_json($jobsJSON), $nixExprInput);}# Return the most recent evaluation of the given jobset (that# optionally had new builds), or undefined if no such evaluation# exists.sub getPrevJobsetEval {my ($db, $jobset, $hasNewBuilds) = @_;my ($prevEval) = $jobset->jobsetevals(($hasNewBuilds ? { hasnewbuilds => 1 } : { }),{ order_by => "id DESC", rows => 1 });return $prevEval;}# Check whether to add the build described by $buildInfo.sub checkBuild {my ($db, $jobset, $inputInfo, $nixExprInput, $buildInfo, $buildMap, $prevEval, $jobOutPathMap, $plugins) = @_;my @outputNames = sort keys %{$buildInfo->{outputs}};die unless scalar @outputNames;# In various checks we can use an arbitrary output (the first)# rather than all outputs, since if one output is the same, the# others will be as well.my $firstOutputName = $outputNames[0];my $firstOutputPath = $buildInfo->{outputs}->{$firstOutputName};my $jobName = $buildInfo->{jobName} or die;my $drvPath = $buildInfo->{drvPath} or die;my $build;txn_do($db, sub {my $job = $jobset->jobs->update_or_create({ name => $jobName });# Don't add a build that has already been scheduled for this# job, or has been built but is still a "current" build for# this job. Note that this means that if the sources of a job# are changed from A to B and then reverted to A, three builds# will be performed (though the last one will probably use the# cached result from the first). This ensures that the builds# with the highest ID will always be the ones that we want in# the channels. FIXME: Checking the output paths doesn't take# meta-attributes into account. For instance, do we want a# new build to be scheduled if the meta.maintainers field is# changed?if (defined $prevEval) {# Only check one output: if it's the same, the other will be as well.my $firstOutput = $outputNames[0];my ($prevBuild) = $prevEval->builds->search(# The "project" and "jobset" constraints are# semantically unnecessary (because they're implied by# the eval), but they give a factor 1000 speedup on# the Nixpkgs jobset with PostgreSQL.{ project => $jobset->project->name, jobset => $jobset->name, job => $jobName,name => $firstOutputName, path => $firstOutputPath },{ rows => 1, columns => ['id'], join => ['buildoutputs'] });if (defined $prevBuild) {#print STDERR " already scheduled/built as build ", $prevBuild->id, "\n";$buildMap->{$prevBuild->id} = { id => $prevBuild->id, jobName => $jobName, new => 0, drvPath => $drvPath };return;}}# Prevent multiple builds with the same (job, outPath) from# being added.my $prev = $$jobOutPathMap{$jobName . "\t" . $firstOutputPath};if (defined $prev) {#print STDERR " already scheduled as build ", $prev, "\n";return;}my $time = time();sub null {my ($s) = @_;return $s eq "" ? undef : $s;}# Add the build to the database.$build = $job->builds->create({ timestamp => $time, description => null($buildInfo->{description}), license => null($buildInfo->{license}), homepage => null($buildInfo->{homepage}), maintainers => null($buildInfo->{maintainers}), maxsilent => $buildInfo->{maxSilent}, timeout => $buildInfo->{timeout}, nixname => $buildInfo->{nixName}, drvpath => $drvPath, system => $buildInfo->{system}, nixexprinput => $jobset->nixexprinput, nixexprpath => $jobset->nixexprpath, priority => $buildInfo->{schedulingPriority}, finished => 0, iscurrent => 1, ischannel => $buildInfo->{isChannel}});$build->buildoutputs->create({ name => $_, path => $buildInfo->{outputs}->{$_} })foreach @outputNames;$buildMap->{$build->id} = { id => $build->id, jobName => $jobName, new => 1, drvPath => $drvPath };$$jobOutPathMap{$jobName . "\t" . $firstOutputPath} = $build->id;print STDERR "added build ${\$build->id} (${\$jobset->project->name}:${\$jobset->name}:$jobName)\n";});return $build;};