~ubuntu-branches/ubuntu/utopic/sbuild/utopic : revision 49

1

#

2

# Build.pm: build library for sbuild

3

4

5

6

#

7

# This program is free software: you can redistribute it and/or modify

8

# it under the terms of the GNU General Public License as published by

9

# the Free Software Foundation, either version 2 of the License, or

10

# (at your option) any later version.

11

#

12

# This program is distributed in the hope that it will be useful, but

13

# WITHOUT ANY WARRANTY; without even the implied warranty of

14

# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU

15

# General Public License for more details.

16

#

17

# You should have received a copy of the GNU General Public License

18

# along with this program. If not, see

19

# <http://www.gnu.org/licenses/>.

20

#

21

#######################################################################

22

23

package Sbuild::Build;

24

25

use strict;

26

use warnings;

27

28

use English;

29

use POSIX;

30

use Errno qw(:POSIX);

31

use Fcntl;

32

use File::Basename qw(basename dirname);

33

use File::Temp qw(tempdir);

34

use FileHandle;

35

use GDBM_File;

36

use File::Copy qw(); # copy is already exported from Sbuild, so don't export

37

# anything.

38

use Dpkg::Arch;

39

use Dpkg::Control;

40

use Dpkg::Version;

41

use MIME::Lite;

42

use Term::ANSIColor;

43

44

use Sbuild qw($devnull binNMU_version copy isin debug df send_mail dsc_files);

45

use Sbuild::Base;

46

use Sbuild::ChrootInfoSchroot;

47

use Sbuild::ChrootInfoSudo;

48

use Sbuild::ChrootRoot;

49

use Sbuild::Sysconfig qw($version $release_date);

50

use Sbuild::Sysconfig;

51

use Sbuild::Utility qw(check_url download);

52

use Sbuild::Resolver qw(get_resolver);

53

use Sbuild::Exception;

54

55

BEGIN {

56

use Exporter ();

57

our (@ISA, @EXPORT);

58

59

@ISA = qw(Exporter Sbuild::Base);

60

61

@EXPORT = qw();

62

}

63

64

our $saved_stdout = undef;

65

our $saved_stderr = undef;

66

67

sub new {

68

my $class = shift;

69

my $dsc = shift;

70

my $conf = shift;

71

72

my $self = $class->SUPER::new($conf);

73

bless($self, $class);

74

75

$self->set('ABORT', undef);

76

$self->set('Job', $dsc);

77

$self->set('Arch', undef);

78

$self->set('Chroot Dir', '');

79

$self->set('Chroot Build Dir', '');

80

$self->set('Build Dir', '');

81

$self->set('Max Lock Trys', 120);

82

$self->set('Lock Interval', 5);

83

$self->set('Pkg Status', 'pending');

84

$self->set('Pkg Status Trigger', undef);

85

$self->set('Pkg Start Time', 0);

86

$self->set('Pkg End Time', 0);

87

$self->set('Pkg Fail Stage', 'init');

88

$self->set('Build Start Time', 0);

89

$self->set('Build End Time', 0);

90

$self->set('Install Start Time', 0);

91

$self->set('Install End Time', 0);

92

$self->set('This Time', 0);

93

$self->set('This Space', 0);

94

$self->set('This Watches', {});

95

$self->set('Sub Task', 'initialisation');

96

$self->set('Host', Sbuild::ChrootRoot->new($self->get('Config')));

97

# Host execution defaults

98

my $host_defaults = $self->get('Host')->get('Defaults');

99

$host_defaults->{'USER'} = $self->get_conf('USERNAME');

100

$host_defaults->{'DIR'} = $self->get_conf('HOME');

101

$host_defaults->{'STREAMIN'} = $devnull;

102

$host_defaults->{'ENV'}->{'LC_ALL'} = 'POSIX';

103

$host_defaults->{'ENV'}->{'SHELL'} = '/bin/sh';

104

$host_defaults->{'ENV_FILTER'} = $self->get_conf('ENVIRONMENT_FILTER');

105

# Note, this should never fail. But, we should handle failure anyway.

106

$self->get('Host')->begin_session();

107

108

$self->set('Session', undef);

109

$self->set('Dependency Resolver', undef);

110

$self->set('Log File', undef);

111

$self->set('Log Stream', undef);

112

$self->set('Summary Stats', {});

113

114

# DSC, package and version information:

115

$self->set_dsc($dsc);

116

my $ver = $self->get('DSC Base');

117

$ver =~ s/\.dsc$//;

118

# Note, will be overwritten by Version: in DSC.

119

$self->set_version($ver);

120

121

# Do we need to download?

122

$self->set('Download', 0);

123

$self->set('Download', 1)

124

if (!($self->get('DSC Base') =~ m/\.dsc$/) || # Use apt to download

125

check_url($self->get('DSC'))); # Valid URL

126

127

# Can sources be obtained?

128

$self->set('Invalid Source', 0);

129

$self->set('Invalid Source', 1)

130

if ((!$self->get('Download') ||

131

(!($self->get('DSC Base') =~ m/\.dsc$/) &&

132

$self->get('DSC') ne $self->get('Package_OVersion')) ||

133

!defined $self->get('Version')));

134

135

debug("Download = " . $self->get('Download') . "\n");

136

debug("Invalid Source = " . $self->get('Invalid Source') . "\n");

137

138

return $self;

139

}

140

141

sub request_abort {

142

my $self = shift;

143

my $reason = shift;

144

145

$self->log_error("ABORT: $reason (requesting cleanup and shutdown)\n");

146

$self->set('ABORT', $reason);

147

}

148

149

sub check_abort {

150

my $self = shift;

151

152

if ($self->get('ABORT')) {

153

Sbuild::Exception::Build->throw(error => "Aborting build: " .

154

$self->get('ABORT'),

155

failstage => "abort");

156

}

157

}

158

159

sub set_dsc {

160

my $self = shift;

161

my $dsc = shift;

162

163

debug("Setting DSC: $dsc\n");

164

165

$self->set('DSC', $dsc);

166

$self->set('Source Dir', dirname($dsc));

167

$self->set('DSC Base', basename($dsc));

168

169

debug("DSC = " . $self->get('DSC') . "\n");

170

debug("Source Dir = " . $self->get('Source Dir') . "\n");

171

debug("DSC Base = " . $self->get('DSC Base') . "\n");

172

}

173

174

sub set_version {

175

my $self = shift;

176

my $pkgv = shift;

177

178

debug("Setting package version: $pkgv\n");

179

180

my ($pkg, $version) = split /_/, $pkgv;

181

my $pver = Dpkg::Version->new($version, check => 1);

182

return if (!defined($pkg) || !defined($version) || !defined($pver));

183

my ($o_version, $o_revision);

184

$o_version = $pver->version();

185

$o_revision = $pver->revision();

186

$o_revision = "" if $pver->{'no_revision'};

187

188

# Original version (no binNMU or other addition)

189

my $oversion = $version;

190

# Original version with stripped epoch

191

my $osversion = $o_version;

192

$osversion .= '-' . $o_revision if $o_revision;

193

194

# Add binNMU to version if needed.

195

if ($self->get_conf('BIN_NMU') || $self->get_conf('APPEND_TO_VERSION')) {

196

$version = binNMU_version($version, $self->get_conf('BIN_NMU_VERSION'),

197

$self->get_conf('APPEND_TO_VERSION'));

198

}

199

200

my $bver = Dpkg::Version->new($version, check => 1);

201

return if (!defined($bver));

202

my ($b_epoch, $b_version, $b_revision);

203

$b_epoch = $bver->epoch();

204

$b_epoch = "" if $bver->{'no_epoch'};

205

$b_version = $bver->version();

206

$b_revision = $bver->revision();

207

$b_revision = "" if $bver->{'no_revision'};

208

209

# Version with binNMU or other additions and stripped epoch

210

my $sversion = $b_version;

211

$sversion .= '-' . $b_revision if $b_revision;

212

213

$self->set('Package', $pkg);

214

$self->set('Version', $version);

215

$self->set('Package_Version', "${pkg}_$version");

216

$self->set('Package_OVersion', "${pkg}_$oversion");

217

$self->set('Package_OSVersion', "${pkg}_$osversion");

218

$self->set('Package_SVersion', "${pkg}_$sversion");

219

$self->set('OVersion', $oversion);

220

$self->set('OSVersion', $osversion);

221

$self->set('SVersion', $sversion);

222

$self->set('VersionEpoch', $b_epoch);

223

$self->set('VersionUpstream', $b_version);

224

$self->set('VersionDebian', $b_revision);

225

$self->set('DSC File', "${pkg}_${osversion}.dsc");

226

$self->set('DSC Dir', "${pkg}-${b_version}");

227

228

debug("Package = " . $self->get('Package') . "\n");

229

debug("Version = " . $self->get('Version') . "\n");

230

debug("Package_Version = " . $self->get('Package_Version') . "\n");

231

debug("Package_OVersion = " . $self->get('Package_OVersion') . "\n");

232

debug("Package_OSVersion = " . $self->get('Package_OSVersion') . "\n");

233

debug("Package_SVersion = " . $self->get('Package_SVersion') . "\n");

234

debug("OVersion = " . $self->get('OVersion') . "\n");

235

debug("OSVersion = " . $self->get('OSVersion') . "\n");

236

debug("SVersion = " . $self->get('SVersion') . "\n");

237

debug("VersionEpoch = " . $self->get('VersionEpoch') . "\n");

238

debug("VersionUpstream = " . $self->get('VersionUpstream') . "\n");

239

debug("VersionDebian = " . $self->get('VersionDebian') . "\n");

240

debug("DSC File = " . $self->get('DSC File') . "\n");

241

debug("DSC Dir = " . $self->get('DSC Dir') . "\n");

242

}

243

244

sub set_status {

245

my $self = shift;

246

my $status = shift;

247

248

$self->set('Pkg Status', $status);

249

if (defined($self->get('Pkg Status Trigger'))) {

250

$self->get('Pkg Status Trigger')->($self, $status);

251

}

252

}

253

254

sub get_status {

255

my $self = shift;

256

257

return $self->get('Pkg Status');

258

}

259

260

# This function is the main entry point into the package build. It

261

# provides a top-level exception handler and does the initial setup

262

# including initiating logging and creating host chroot. The nested

263

# run_ functions it calls are separate in order to permit running

264

# cleanup tasks in a strict order.

265

sub run {

266

my $self = shift;

267

268

eval {

269

$self->check_abort();

270

271

$self->set_status('building');

272

273

$self->set('Pkg Start Time', time);

274

$self->set('Pkg End Time', $self->get('Pkg Start Time'));

275

276

# Acquire the architecture we're building for.

277

$self->set('Arch', $self->get_conf('ARCH'));

278

279

my $dist = $self->get_conf('DISTRIBUTION');

280

if (!defined($dist) || !$dist) {

281

Sbuild::Exception::Build->throw(error => "No distribution defined",

282

failstage => "init");

283

}

284

285

if ($self->get('Invalid Source')) {

286

Sbuild::Exception::Build->throw(error => "Invalid source " . $self->get('DSC'),

287

failstage => "init");

288

}

289

290

# TODO: Get package name from build object

291

if (!$self->open_build_log()) {

292

Sbuild::Exception::Build->throw(error => "Failed to open build log",

293

failstage => "init");

294

}

295

296

# Set a chroot to run commands in host

297

my $host = $self->get('Host');

298

299

# Host execution defaults (set streams)

300

my $host_defaults = $host->get('Defaults');

301

$host_defaults->{'STREAMIN'} = $devnull;

302

$host_defaults->{'STREAMOUT'} = $self->get('Log Stream');

303

$host_defaults->{'STREAMERR'} = $self->get('Log Stream');

304

305

$self->check_abort();

306

$self->run_chroot();

307

};

308

309

my $e;

310

if ($e = Exception::Class->caught('Sbuild::Exception::Build')) {

311

if ($e->status) {

312

$self->set_status($e->status);

313

} else {

314

$self->set_status("failed");

315

}

316

$self->set('Pkg Fail Stage', $e->failstage);

317

$e->rethrow();

318

}

319

}

320

321

# Pack up source if needed and then run the main chroot session.

322

# Close log during return/failure.

323

sub run_chroot {

324

my $self = shift;

325

326

eval {

327

$self->check_abort();

328

$self->run_chroot_session();

329

};

330

331

# Log exception info and set status and fail stage prior to

332

# closing build log.

333

my $e;

334

if ($e = Exception::Class->caught('Sbuild::Exception::Build')) {

335

$self->log_error("$e\n");

336

$self->log_info($e->info."\n")

337

if ($e->info);

338

if ($e->status) {

339

$self->set_status($e->status);

340

} else {

341

$self->set_status("failed");

342

}

343

$self->set('Pkg Fail Stage', $e->failstage);

344

}

345

346

$self->close_build_log();

347

348

if ($e) {

349

$e->rethrow();

350

}

351

}

352

353

# Create main chroot session and package resolver. Creates a lock in

354

# the chroot to prevent concurrent chroot usage (only important for

355

# non-snapshot chroots). Ends chroot session on return/failure.

356

sub run_chroot_session {

357

my $self=shift;

358

359

eval {

360

$self->check_abort();

361

my $chroot_info;

362

if ($self->get_conf('CHROOT_MODE') eq 'schroot') {

363

$chroot_info = Sbuild::ChrootInfoSchroot->new($self->get('Config'));

364

} else {

365

$chroot_info = Sbuild::ChrootInfoSudo->new($self->get('Config'));

366

}

367

368

my $host = $self->get('Host');

369

370

my $session = $chroot_info->create('chroot',

371

$self->get_conf('DISTRIBUTION'),

372

$self->get_conf('CHROOT'),

373

$self->get_conf('ARCH'));

374

375

# Run pre build external commands

376

$self->check_abort();

377

$self->run_external_commands("pre-build-commands",

378

$self->get_conf('LOG_EXTERNAL_COMMAND_OUTPUT'),

379

$self->get_conf('LOG_EXTERNAL_COMMAND_ERROR'));

380

381

$self->check_abort();

382

if (!$session->begin_session()) {

383

Sbuild::Exception::Build->throw(error => "Error creating chroot session: skipping " .

384

$self->get('Package'),

385

failstage => "create-session");

386

}

387

388

$self->set('Session', $session);

389

390

$self->check_abort();

391

my $chroot_arch = $self->chroot_arch();

392

if ($self->get('Arch') ne $chroot_arch) {

393

Sbuild::Exception::Build->throw(error => "Build architecture (" . $self->get('Arch') .

394

") is not the same as the chroot architecture (" .

395

$chroot_arch . ")",

396

info => "Please specify the correct architecture with --arch, or use a chroot of the correct architecture",

397

failstage => "create-session");

398

}

399

400

$self->set('Chroot Dir', $session->get('Location'));

401

# TODO: Don't hack the build location in; add a means to customise

402

# the chroot directly. i.e. allow changing of /build location.

403

$self->set('Chroot Build Dir',

404

tempdir($self->get('Package') . '-XXXXXX',

405

DIR => $session->get('Location') . "/build"));

406

407

$self->set('Build Dir', $session->strip_chroot_path($self->get('Chroot Build Dir')));

408

409

# Log colouring

410

$self->build_log_colour('red', '^E: ');

411

$self->build_log_colour('yellow', '^W: ');

412

$self->build_log_colour('green', '^I: ');

413

$self->build_log_colour('red', '^Status:');

414

$self->build_log_colour('green', '^Status: successful$');

415

$self->build_log_colour('red', '^Lintian:');

416

$self->build_log_colour('green', '^Lintian: pass$');

417

418

# Log filtering

419

my $filter;

420

$filter = $self->get('Build Dir') . '/' . $self->get('DSC Dir');

421

$filter =~ s;^/;;;

422

$self->build_log_filter($filter, 'PKGBUILDDIR');

423

$filter = $self->get('Build Dir');

424

$filter =~ s;^/;;;

425

$self->build_log_filter($filter, 'BUILDDIR');

426

$filter = $session->get('Location');

427

$filter =~ s;^/;;;

428

$self->build_log_filter($filter , 'CHROOT');

429

430

# Need tempdir to be writable and readable by sbuild group.

431

$self->check_abort();

432

$session->run_command(

433

{ COMMAND => ['chown', $self->get_conf('BUILD_USER') . ':sbuild',

434

$self->get('Build Dir')],

435

USER => 'root',

436

DIR => '/' });

437

if ($?) {

438

Sbuild::Exception::Build->throw(error => "Failed to set sbuild group ownership on chroot build dir",

439

failstage => "create-build-dir");

440

}

441

$self->check_abort();

442

$session->run_command(

443

{ COMMAND => ['chmod', '0770', $self->get('Build Dir')],

444

USER => 'root',

445

DIR => '/' });

446

if ($?) {

447

Sbuild::Exception::Build->throw(error => "Failed to set sbuild group ownership on chroot build dir",

448

failstage => "create-build-dir");

449

}

450

451

$self->check_abort();

452

# Needed so chroot commands log to build log

453

$session->set('Log Stream', $self->get('Log Stream'));

454

$host->set('Log Stream', $self->get('Log Stream'));

455

456

# Chroot execution defaults

457

my $chroot_defaults = $session->get('Defaults');

458

$chroot_defaults->{'DIR'} = $self->get('Build Dir');

459

$chroot_defaults->{'STREAMIN'} = $devnull;

460

$chroot_defaults->{'STREAMOUT'} = $self->get('Log Stream');

461

$chroot_defaults->{'STREAMERR'} = $self->get('Log Stream');

462

$chroot_defaults->{'ENV'}->{'LC_ALL'} = 'POSIX';

463

$chroot_defaults->{'ENV'}->{'SHELL'} = '/bin/sh';

464

$chroot_defaults->{'ENV'}->{'HOME'} = '/sbuild-nonexistent';

465

$chroot_defaults->{'ENV_FILTER'} = $self->get_conf('ENVIRONMENT_FILTER');

466

467

my $resolver = get_resolver($self->get('Config'), $session, $host);

468

$resolver->set('Log Stream', $self->get('Log Stream'));

469

$resolver->set('Arch', $self->get('Arch'));

470

$resolver->set('Chroot Build Dir', $self->get('Chroot Build Dir'));

471

$self->set('Dependency Resolver', $resolver);

472

473

# Lock chroot so it won't be tampered with during the build.

474

$self->check_abort();

475

if (!$session->lock_chroot($self->get('Package_SVersion'), $$, $self->get_conf('USERNAME'))) {

476

Sbuild::Exception::Build->throw(error => "Error locking chroot session: skipping " .

477

$self->get('Package'),

478

failstage => "lock-session");

479

}

480

481

$self->check_abort();

482

$self->run_chroot_session_locked();

483

};

484

485

# End chroot session

486

my $session = $self->get('Session');

487

my $end_session =

488

($self->get_conf('PURGE_SESSION') eq 'always' ||

489

($self->get_conf('PURGE_SESSION') eq 'successful' &&

490

$self->get_status() eq 'successful')) ? 1 : 0;

491

if ($end_session) {

492

$session->end_session();

493

} else {

494

$self->log("Keeping session: " . $session->get('Session ID') . "\n");

495

}

496

$session = undef;

497

$self->set('Session', $session);

498

499

my $e;

500

if ($e = Exception::Class->caught('Sbuild::Exception::Build')) {

501

$e->rethrow();

502

}

503

}

504

505

# Run tasks in a *locked* chroot. Update and upgrade packages.

506

# Unlocks chroot on return/failure.

507

sub run_chroot_session_locked {

508

my $self = shift;

509

510

eval {

511

my $session = $self->get('Session');

512

my $resolver = $self->get('Dependency Resolver');

513

514

$self->check_abort();

515

$resolver->setup();

516

517

$self->check_abort();

518

$self->run_chroot_update();

519

520

$self->check_abort();

521

$self->run_fetch_install_packages();

522

};

523

524

my $session = $self->get('Session');

525

my $resolver = $self->get('Dependency Resolver');

526

527

$resolver->cleanup();

528

# Unlock chroot now it's cleaned up and ready for other users.

529

$session->unlock_chroot();

530

531

my $e;

532

if ($e = Exception::Class->caught('Sbuild::Exception::Build')) {

533

$e->rethrow();

534

}

535

}

536

537

sub run_chroot_update {

538

my $self = shift;

539

my $resolver = $self->get('Dependency Resolver');

540

541

if ($self->get_conf('APT_CLEAN') || $self->get_conf('APT_UPDATE') ||

542

$self->get_conf('APT_DISTUPGRADE') || $self->get_conf('APT_UPGRADE')) {

543

$self->log_subsection('Update chroot');

544

}

545

546

# Clean APT cache.

547

$self->check_abort();

548

if ($self->get_conf('APT_CLEAN')) {

549

if ($resolver->clean()) {

550

# Since apt-clean was requested specifically, fail on

551

# error when not in buildd mode.

552

$self->log("apt-get clean failed\n");

553

if ($self->get_conf('SBUILD_MODE') ne 'buildd') {

554

Sbuild::Exception::Build->throw(error => "apt-get clean failed",

555

failstage => "apt-get-clean");

556

}

557

}

558

}

559

560

# Update APT cache.

561

$self->check_abort();

562

if ($self->get_conf('APT_UPDATE')) {

563

if ($resolver->update()) {

564

# Since apt-update was requested specifically, fail on

565

# error when not in buildd mode.

566

if ($self->get_conf('SBUILD_MODE') ne 'buildd') {

567

Sbuild::Exception::Build->throw(error => "apt-get update failed",

568

failstage => "apt-get-update");

569

}

570

}

571

}

572

573

# Upgrade using APT.

574

$self->check_abort();

575

if ($self->get_conf('APT_DISTUPGRADE')) {

576

if ($self->get_conf('APT_DISTUPGRADE')) {

577

if ($resolver->distupgrade()) {

578

# Since apt-distupgrade was requested specifically, fail on

579

# error when not in buildd mode.

580

if ($self->get_conf('SBUILD_MODE') ne 'buildd') {

581

Sbuild::Exception::Build->throw(error => "apt-get dist-upgrade failed",

582

failstage => "apt-get-dist-upgrade");

583

}

584

}

585

}

586

} elsif ($self->get_conf('APT_UPGRADE')) {

587

if ($self->get_conf('APT_UPGRADE')) {

588

if ($resolver->upgrade()) {

589

# Since apt-upgrade was requested specifically, fail on

590

# error when not in buildd mode.

591

if ($self->get_conf('SBUILD_MODE') ne 'buildd') {

592

Sbuild::Exception::Build->throw(error => "apt-get upgrade failed",

593

failstage => "apt-get-upgrade");

594

}

595

}

596

}

597

}

598

}

599

600

# Fetch sources, run setup, fetch and install core and package build

601

# deps, then run build. Cleans up build directory and uninstalls

602

# build depends on return/failure.

603

sub run_fetch_install_packages {

604

my $self = shift;

605

606

$self->check_abort();

607

eval {

608

my $session = $self->get('Session');

609

my $resolver = $self->get('Dependency Resolver');

610

611

$self->check_abort();

612

if (!$self->fetch_source_files()) {

613

Sbuild::Exception::Build->throw(error => "Failed to fetch source files",

614

failstage => "fetch-src");

615

}

616

617

# Display message about chroot setup script option use being deprecated

618

if ($self->get_conf('CHROOT_SETUP_SCRIPT')) {

619

my $msg = "setup-hook option is deprecated. It has been superceded by ";

620

$msg .= "the chroot-setup-commands feature. setup-hook script will be ";

621

$msg .= "run via chroot-setup-commands.\n";

622

$self->log_warning($msg);

623

}

624

625

# Run specified chroot setup commands

626

$self->check_abort();

627

$self->run_external_commands("chroot-setup-commands",

628

$self->get_conf('LOG_EXTERNAL_COMMAND_OUTPUT'),

629

$self->get_conf('LOG_EXTERNAL_COMMAND_ERROR'));

630

631

$self->check_abort();

632

$self->set('Install Start Time', time);

633

$self->set('Install End Time', $self->get('Install Start Time'));

634

$resolver->add_dependencies('CORE', join(", ", @{$self->get_conf('CORE_DEPENDS')}) , "", "", "", "", "");

635

if (!$resolver->install_deps('core', 'CORE')) {

636

Sbuild::Exception::Build->throw(error => "Core build dependencies not satisfied; skipping",

637

failstage => "install-deps");

638

}

639

640

$resolver->add_dependencies('ESSENTIAL', $self->read_build_essential(), "", "", "", "", "");

641

642

my $snapshot = "";

643

$snapshot = "gcc-snapshot" if ($self->get_conf('GCC_SNAPSHOT'));

644

$resolver->add_dependencies('GCC_SNAPSHOT', $snapshot , "", "", "", "", "");

645

646

# Add additional build dependencies specified on the command-line.

647

# TODO: Split dependencies into an array from the start to save

648

# lots of joining.

649

$resolver->add_dependencies('MANUAL',

650

join(", ", @{$self->get_conf('MANUAL_DEPENDS')}),

651

join(", ", @{$self->get_conf('MANUAL_DEPENDS_ARCH')}),

652

join(", ", @{$self->get_conf('MANUAL_DEPENDS_INDEP')}),

653

join(", ", @{$self->get_conf('MANUAL_CONFLICTS')}),

654

join(", ", @{$self->get_conf('MANUAL_CONFLICTS_ARCH')}),

655

join(", ", @{$self->get_conf('MANUAL_CONFLICTS_INDEP')}));

656

657

$resolver->add_dependencies($self->get('Package'),

658

$self->get('Build Depends'),

659

$self->get('Build Depends Arch'),

660

$self->get('Build Depends Indep'),

661

$self->get('Build Conflicts'),

662

$self->get('Build Conflicts Arch'),

663

$self->get('Build Conflicts Indep'));

664

665

$self->check_abort();

666

if (!$resolver->install_deps($self->get('Package'),

667

'ESSENTIAL', 'GCC_SNAPSHOT', 'MANUAL',

668

$self->get('Package'))) {

669

Sbuild::Exception::Build->throw(error => "Package build dependencies not satisfied; skipping",

670

failstage => "install-deps");

671

}

672

$self->set('Install End Time', time);

673

674

$self->check_abort();

675

$resolver->dump_build_environment();

676

677

$self->check_abort();

678

$self->prepare_watches(keys %{$resolver->get('Changes')->{'installed'}});

679

680

$self->check_abort();

681

if ($self->build()) {

682

$self->set_status('successful');

683

} else {

684

$self->set('Pkg Fail Stage', "build");

685

$self->set_status('failed');

686

}

687

688

# Run specified chroot cleanup commands

689

$self->check_abort();

690

$self->run_external_commands("chroot-cleanup-commands",

691

$self->get_conf('LOG_EXTERNAL_COMMAND_OUTPUT'),

692

$self->get_conf('LOG_EXTERNAL_COMMAND_ERROR'));

693

694

if ($self->get('Pkg Status') eq "successful") {

695

$self->log_subsection("Post Build");

696

697

# Run lintian.

698

$self->check_abort();

699

$self->run_lintian();

700

701

# Run piuparts.

702

$self->check_abort();

703

$self->run_piuparts();

704

705

# Run post build external commands

706

$self->check_abort();

707

$self->run_external_commands("post-build-commands",

708

$self->get_conf('LOG_EXTERNAL_COMMAND_OUTPUT'),

709

$self->get_conf('LOG_EXTERNAL_COMMAND_ERROR'));

710

711

}

712

};

713

714

$self->log_subsection("Cleanup");

715

my $session = $self->get('Session');

716

my $resolver = $self->get('Dependency Resolver');

717

718

my $purge_build_directory =

719

($self->get_conf('PURGE_BUILD_DIRECTORY') eq 'always' ||

720

($self->get_conf('PURGE_BUILD_DIRECTORY') eq 'successful' &&

721

$self->get_status() eq 'successful')) ? 1 : 0;

722

my $purge_build_deps =

723

($self->get_conf('PURGE_BUILD_DEPS') eq 'always' ||

724

($self->get_conf('PURGE_BUILD_DEPS') eq 'successful' &&

725

$self->get_status() eq 'successful')) ? 1 : 0;

726

my $is_cloned_session = (defined ($session->get('Session Purged')) &&

727

$session->get('Session Purged') == 1) ? 1 : 0;

728

729

if ($purge_build_directory) {

730

# Purge package build directory

731

$self->log("Purging " . $self->get('Build Dir') . "\n");

732

$self->get('Session')->run_command(

733

{ COMMAND => ['rm', '-rf', $self->get('Build Dir')],

734

USER => 'root',

735

PRIORITY => 0,

736

DIR => '/' });

737

}

738

739

# Purge non-cloned session

740

if ($is_cloned_session) {

741

$self->log("Not cleaning session: cloned chroot in use\n");

742

} else {

743

if ($purge_build_deps) {

744

# Removing dependencies

745

$resolver->uninstall_deps();

746

} else {

747

$self->log("Not removing build depends: as requested\n");

748

}

749

}

750

751

my $e;

752

if ($e = Exception::Class->caught('Sbuild::Exception::Build')) {

753

$e->rethrow();

754

}

755

}

756

757

sub copy_to_chroot {

758

my $self = shift;

759

my $source = shift;

760

my $dest = shift;

761

762

$self->check_abort();

763

if (! File::Copy::copy($source, $dest)) {

764

$self->log_error("E: Failed to copy '$source' to '$dest': $!\n");

765

exit (1);

766

return 0;

767

}

768

769

$self->get('Session')->run_command(

770

{ COMMAND => ['chown', $self->get_conf('BUILD_USER') . ':sbuild',

771

$self->get('Session')->strip_chroot_path($dest) . '/' .

772

basename($source)],

773

USER => 'root',

774

DIR => '/' });

775

if ($?) {

776

$self->log_error("E: Failed to set sbuild group ownership on $dest\n");

777

return 0;

778

}

779

$self->get('Session')->run_command(

780

{ COMMAND => ['chmod', '0664',

781

$self->get('Session')->strip_chroot_path($dest) . '/' .

782

basename($source)],

783

USER => 'root',

784

DIR => '/' });

785

if ($?) {

786

$self->log_error("E: Failed to set 0644 permissions on $dest\n");

787

return 0;

788

}

789

790

return 1;

791

}

792

sub fetch_source_files {

793

my $self = shift;

794

795

my $dir = $self->get('Source Dir');

796

my $dsc = $self->get('DSC File');

797

my $build_dir = $self->get('Chroot Build Dir');

798

my $pkg = $self->get('Package');

799

my $ver = $self->get('OVersion');

800

my $arch = $self->get('Arch');

801

802

my ($dscarchs, $dscpkg, $dscver, @fetched);

803

804

my $build_depends = "";

805

my $build_depends_arch = "";

806

my $build_depends_indep = "";

807

my $build_conflicts = "";

808

my $build_conflicts_arch = "";

809

my $build_conflicts_indep = "";

810

local( *F );

811

812

$self->log_subsection("Fetch source files");

813

814

if (!defined($self->get('Package')) ||

815

!defined($self->get('OVersion')) ||

816

!defined($self->get('Source Dir'))) {

817

$self->log("Invalid source: $self->get('DSC')\n");

818

return 0;

819

}

820

821

$self->check_abort();

822

if ($self->get('DSC Base') =~ m/\.dsc$/) {

823

# Work with a .dsc file.

824

# $file is the name of the downloaded dsc file written in a tempfile.

825

my $file;

826

$file = download($self->get('DSC')) or

827

$self->log_error("Could not download " . $self->get('DSC') . "\n") and

828

return 0;

829

my @cwd_files = dsc_files($file);

830

831

if (-f "$dir/$dsc") {

832

# Copy the local source files into the build directory.

833

$self->log_subsubsection("Local sources");

834

$self->log("$dsc exists in $dir; copying to chroot\n");

835

if (! $self->copy_to_chroot("$dir/$dsc", "$build_dir")) {

836

return 0;

837

}

838

push(@fetched, "$build_dir/$dsc");

839

foreach (@cwd_files) {

840

if (! $self->copy_to_chroot("$dir/$_", "$build_dir")) {

841

return 0;

842

}

843

push(@fetched, "$build_dir/$_");

844

}

845

} else {

846

# Copy the remote source files into the build directory.

847

$self->log_subsubsection("Remote sources");

848

$self->log("Downloading source files from $dir.\n");

849

if (! File::Copy::copy("$file", "$build_dir/" . $self->get('DSC File'))) {

850

$self->log_error("Could not copy downloaded file $file to $build_dir\n");

851

return 0;

852

}

853

push(@fetched, "$build_dir/" . $self->get('DSC File'));

854

foreach (@cwd_files) {

855

download("$dir/$_", "$build_dir/$_") or

856

$self->log_error("Could not download $dir/$_") and

857

return 0;

858

push(@fetched, "$build_dir/$_");

859

}

860

}

861

} else {

862

# Use apt to download the source files

863

$self->log_subsubsection("Check APT");

864

my %entries = ();

865

my $retried = $self->get_conf('APT_UPDATE'); # Already updated if set

866

retry:

867

$self->log("Checking available source versions...\n");

868

869

my $pipe = $self->get('Dependency Resolver')->pipe_apt_command(

870

{ COMMAND => [$self->get_conf('APT_CACHE'),

871

'-q', 'showsrc', "$pkg"],

872

USER => $self->get_conf('BUILD_USER'),

873

PRIORITY => 0,

874

DIR => '/'});

875

if (!$pipe) {

876

$self->log("Can't open pipe to ".$self->get_conf('APT_UPDATE').": $!\n");

877

return 0;

878

}

879

880

{

881

local($/) = "";

882

my $package;

883

my $ver;

884

my $tfile;

885

while( <$pipe> ) {

886

$package = $1 if /^Package:\s+(\S+)\s*$/mi;

887

$ver = $1 if /^Version:\s+(\S+)\s*$/mi;

888

$tfile = $1 if /^Files:\s*\n((\s+.*\s*\n)+)/mi;

889

if (defined $package && defined $ver && defined $tfile) {

890

@{$entries{"$package $ver"}} = map { (split( /\s+/, $_ ))[3] }

891

split( "\n", $tfile );

892

undef($package);

893

undef($ver);

894

undef($tfile);

895

}

896

}

897

898

if (! scalar keys %entries) {

899

$self->log($self->get_conf('APT_CACHE') .

900

" returned no information about $pkg source\n");

901

$self->log("Are there any deb-src lines in your /etc/apt/sources.list?\n");

902

return 0;

903

904

}

905

}

906

close($pipe);

907

908

if ($?) {

909

$self->log($self->get_conf('APT_CACHE') . " exit status $?: $!\n");

910

return 0;

911

}

912

913

if (!defined($entries{"$pkg $ver"})) {

914

if (!$retried) {

915

$self->log_subsubsection("Update APT");

916

# try to update apt's cache if nothing found

917

$self->get('Dependency Resolver')->update();

918

$retried = 1;

919

goto retry;

920

}

921

$self->log("Can't find source for " .

922

$self->get('Package_OVersion') . "\n");

923

$self->log("(only different version(s) ",

924

join( ", ", sort keys %entries), " found)\n")

925

if %entries;

926

return 0;

927

}

928

929

$self->log_subsubsection("Download source files with APT");

930

931

foreach (@{$entries{"$pkg $ver"}}) {

932

push(@fetched, "$build_dir/$_");

933

}

934

935

my $pipe2 = $self->get('Dependency Resolver')->pipe_apt_command(

936

{ COMMAND => [$self->get_conf('APT_GET'), '--only-source', '-q', '-d', 'source', "$pkg=$ver"],

937

USER => $self->get_conf('BUILD_USER'),

938

PRIORITY => 0}) || return 0;

939

940

while(<$pipe2>) {

941

$self->log($_);

942

}

943

close($pipe2);

944

if ($?) {

945

$self->log($self->get_conf('APT_GET') . " for sources failed\n");

946

return 0;

947

}

948

$self->set_dsc((grep { /\.dsc$/ } @fetched)[0]);

949

}

950

951

my $pdsc = Dpkg::Control->new(type => CTRL_PKG_SRC);

952

$pdsc->set_options(allow_pgp => 1);

953

if (!$pdsc->load("$build_dir/$dsc")) {

954

$self->log("Error parsing $build_dir/$dsc");

955

return 0;

956

}

957

958

$build_depends = $pdsc->{'Build-Depends'};

959

$build_depends_arch = $pdsc->{'Build-Depends-Arch'};

960

$build_depends_indep = $pdsc->{'Build-Depends-Indep'};

961

$build_conflicts = $pdsc->{'Build-Conflicts'};

962

$build_conflicts_arch = $pdsc->{'Build-Conflicts-Arch'};

963

$build_conflicts_indep = $pdsc->{'Build-Conflicts-Indep'};

964

$dscarchs = $pdsc->{'Architecture'};

965

$dscpkg = $pdsc->{'Source'};

966

$dscver = $pdsc->{'Version'};

967

968

$self->set_version("${dscpkg}_${dscver}");

969

970

$build_depends =~ s/\n\s+/ /g if defined $build_depends;

971

$build_depends_arch =~ s/\n\s+/ /g if defined $build_depends_arch;

972

$build_depends_indep =~ s/\n\s+/ /g if defined $build_depends_indep;

973

$build_conflicts =~ s/\n\s+/ /g if defined $build_conflicts;

974

$build_conflicts_arch =~ s/\n\s+/ /g if defined $build_conflicts_arch;

975

$build_conflicts_indep =~ s/\n\s+/ /g if defined $build_conflicts_indep;

976

977

$self->log_subsubsection("Check arch");

978

if (!$dscarchs) {

979

$self->log("$dsc has no Architecture: field -- skipping arch check!\n");

980

} else {

981

my $valid_arch;

982

for my $a (split(/\s+/, $dscarchs)) {

983

if (Dpkg::Arch::debarch_is($arch, $a)) {

984

$valid_arch = 1;

985

last;

986

}

987

}

988

if ($dscarchs ne "any" && !($valid_arch) &&

989

!($dscarchs eq "all" && $self->get_conf('BUILD_ARCH_ALL')) ) {

990

my $msg = "$dsc: $arch not in arch list or does not match any arch wildcards: $dscarchs -- skipping\n";

991

$self->log($msg);

992

Sbuild::Exception::Build->throw(error => "$dsc: $arch not in arch list or does not match any arch wildcards: $dscarchs -- skipping",

993

status => "skipped",

994

failstage => "arch-check");

995

return 0;

996

}

997

}

998

999

debug("Arch check ok ($arch included in $dscarchs)\n");

1000

1001

$self->set('Build Depends', $build_depends);

1002

$self->set('Build Depends Arch', $build_depends_arch);

1003

$self->set('Build Depends Indep', $build_depends_indep);

1004

$self->set('Build Conflicts', $build_conflicts);

1005

$self->set('Build Conflicts Arch', $build_conflicts_arch);

1006

$self->set('Build Conflicts Indep', $build_conflicts_indep);

1007

1008

return 1;

1009

}

1010

1011

# Subroutine that runs any command through the system (i.e. not through the

1012

# chroot. It takes a string of a command with arguments to run along with

1013

# arguments whether to save STDOUT and/or STDERR to the log stream

1014

sub run_command {

1015

my $self = shift;

1016

my $command = shift;

1017

my $log_output = shift;

1018

my $log_error = shift;

1019

my $chroot = shift;

1020

1021

# Used to determine if we are to log from commands

1022

my ($out, $err, $defaults);

1023

1024

# Run the command and save the exit status

1025

if (!$chroot)

1026

{

1027

$defaults = $self->get('Host')->{'Defaults'};

1028

$out = $defaults->{'STREAMOUT'} if ($log_output);

1029

$err = $defaults->{'STREAMERR'} if ($log_error);

1030

$self->get('Host')->run_command(

1031

{ COMMAND => \@{$command},

1032

PRIORITY => 0,

1033

STREAMOUT => $out,

1034

STREAMERR => $err,

1035

});

1036

} else {

1037

$defaults = $self->get('Session')->{'Defaults'};

1038

$out = $defaults->{'STREAMOUT'} if ($log_output);

1039

$err = $defaults->{'STREAMERR'} if ($log_error);

1040

$self->get('Session')->run_command(

1041

{ COMMAND => \@{$command},

1042

USER => $self->get_conf('BUILD_USER'),

1043

PRIORITY => 0,

1044

STREAMOUT => $out,

1045

STREAMERR => $err,

1046

});

1047

}

1048

my $status = $?;

1049

1050

# Check if the command failed

1051

if ($status != 0) {

1052

return 0;

1053

}

1054

return 1;

1055

}

1056

1057

# Subroutine that processes external commands to be run during various stages of

1058

# an sbuild run. We also ask if we want to log any output from the commands

1059

sub run_external_commands {

1060

my $self = shift;

1061

my $stage = shift;

1062

my $log_output = shift;

1063

my $log_error = shift;

1064

1065

# Return success now unless there are commands to run

1066

return 1 unless (${$self->get_conf('EXTERNAL_COMMANDS')}{$stage});

1067

1068

# Determine which set of commands to run based on the parameter $stage

1069

my @commands = @{${$self->get_conf('EXTERNAL_COMMANDS')}{$stage}};

1070

return 1 if !(@commands);

1071

1072

# Create appropriate log message and determine if the commands are to be

1073

# run inside the chroot or not.

1074

my $chroot = 0;

1075

if ($stage eq "pre-build-commands") {

1076

$self->log_subsection("Pre Build Commands");

1077

} elsif ($stage eq "chroot-setup-commands") {

1078

$self->log_subsection("Chroot Setup Commands");

1079

$chroot = 1;

1080

} elsif ($stage eq "chroot-cleanup-commands") {

1081

$self->log_subsection("Chroot Cleanup Commands");

1082

$chroot = 1;

1083

} elsif ($stage eq "post-build-commands") {

1084

$self->log_subsection("Post Build Commands");

1085

}

1086

1087

# Run each command, substituting the various percent escapes (like

1088

# %SBUILD_DSC) from the commands to run with the appropriate subsitutions.

1089

my $dsc = $self->get('DSC');

1090

my $changes;

1091

$changes = $self->get('Changes File') if ($self->get('Changes File'));

1092

my %percent = (

1093

"%" => "%",

1094

"d" => $dsc, "SBUILD_DSC" => $dsc,

1095

"c" => $changes, "SBUILD_CHANGES" => $changes,

1096

);

1097

# Our escapes pattern, with longer escapes first, then sorted lexically.

1098

my $keyword_pat = join("|",

1099

sort {length $b <=> length $a || $a cmp $b} keys %percent);

1100

my $returnval = 1;

1101

foreach my $command (@commands) {

1102

foreach my $arg (@{$command}) {

1103

$arg =~ s{

1104

# Match a percent followed by a valid keyword

1105

\%($keyword_pat)

1106

}{

1107

# Substitute with the appropriate value only if it's defined

1108

$percent{$1} || $&

1109

}msxge;

1110

}

1111

my $command_str = join(" ", @{$command});

1112

$self->log_subsubsection("$command_str");

1113

$returnval = $self->run_command($command, $log_output, $log_error, $chroot);

1114

$self->log("\n");

1115

if (!$returnval) {

1116

$self->log_error("Command '$command_str' failed to run.\n");

1117

} else {

1118

$self->log_info("Finished running '$command_str'.\n");

1119

}

1120

}

1121

$self->log("\nFinished processing commands.\n");

1122

$self->log_sep();

1123

return $returnval;

1124

}

1125

1126

sub run_lintian {

1127

my $self = shift;

1128

1129

return 1 unless ($self->get_conf('RUN_LINTIAN'));

1130

1131

$self->log_subsubsection("lintian");

1132

1133

my $lintian = $self->get_conf('LINTIAN');

1134

my @lintian_command = ($lintian);

1135

push @lintian_command, @{$self->get_conf('LINTIAN_OPTIONS')} if

1136

($self->get_conf('LINTIAN_OPTIONS'));

1137

push @lintian_command, $self->get('Changes File');

1138

$self->get('Host')->run_command(

1139

{ COMMAND => \@lintian_command,

1140

PRIORITY => 0,

1141

});

1142

my $status = $? >> 8;

1143

$self->set('Lintian Reason', 'pass');

1144

1145

$self->log("\n");

1146

if ($?) {

1147

my $why = "unknown reason";

1148

$self->set('Lintian Reason', 'error');

1149

$self->set('Lintian Reason', 'fail') if ($status == 1);

1150

$why = "runtime error" if ($status == 2);

1151

$why = "policy violation" if ($status == 1);

1152

$why = "received signal " . $? & 127 if ($? & 127);

1153

$self->log_error("Lintian run failed ($why)\n");

1154

1155

return 0;

1156

}

1157

1158

$self->log_info("Lintian run was successful.\n");

1159

return 1;

1160

}

1161

1162

sub run_piuparts {

1163

my $self = shift;

1164

1165

return 1 unless ($self->get_conf('RUN_PIUPARTS'));

1166

1167

$self->log_subsubsection("piuparts");

1168

1169

my $piuparts = $self->get_conf('PIUPARTS');

1170

my @piuparts_command;

1171

if (scalar(@{$self->get_conf('PIUPARTS_ROOT_ARGS')})) {

1172

push @piuparts_command, @{$self->get_conf('PIUPARTS_ROOT_ARGS')};

1173

} else {

1174

push @piuparts_command, 'sudo', '--';

1175

}

1176

push @piuparts_command, $piuparts;

1177

push @piuparts_command, @{$self->get_conf('PIUPARTS_OPTIONS')} if

1178

($self->get_conf('PIUPARTS_OPTIONS'));

1179

push @piuparts_command, $self->get('Changes File');

1180

$self->get('Host')->run_command(

1181

{ COMMAND => \@piuparts_command,

1182

PRIORITY => 0,

1183

});

1184

my $status = $? >> 8;

1185

$self->set('Piuparts Reason', 'pass');

1186

1187

$self->log("\n");

1188

if ($?) {

1189

$self->log_error("Piuparts run failed.\n");

1190

$self->set('Piuparts Reason', 'fail');

1191

return 0;

1192

}

1193

1194

$self->log_info("Piuparts run was successful.\n");

1195

return 1;

1196

}

1197

1198

sub build {

1199

my $self = shift;

1200

1201

my $dscfile = $self->get('DSC File');

1202

my $dscdir = $self->get('DSC Dir');

1203

my $pkg = $self->get('Package');

1204

my $build_dir = $self->get('Chroot Build Dir');

1205

my $arch = $self->get('Arch');

1206

1207

my( $rv, $changes );

1208

local( *PIPE, *F, *F2 );

1209

1210

$self->log_subsection("Build");

1211

$self->set('This Space', 0);

1212

1213

my $tmpunpackdir = $dscdir;

1214

$tmpunpackdir =~ s/-.*$/.orig.tmp-nest/;

1215

$tmpunpackdir =~ s/_/-/;

1216

$tmpunpackdir = "$build_dir/$tmpunpackdir";

1217

1218

$self->log_subsubsection("Unpack source");

1219

if (-d "$build_dir/$dscdir" && -l "$build_dir/$dscdir") {

1220

# if the package dir already exists but is a symlink, complain

1221

$self->log("Cannot unpack source: a symlink to a directory with the\n".

1222

"same name already exists.\n");

1223

return 0;

1224

}

1225

if (! -d "$build_dir/$dscdir") {

1226

$self->set('Sub Task', "dpkg-source");

1227

$self->get('Session')->run_command(

1228

{ COMMAND => [$self->get_conf('DPKG_SOURCE'),

1229

'-x', $dscfile, $dscdir],

1230

USER => $self->get_conf('BUILD_USER'),

1231

PRIORITY => 0});

1232

if ($?) {

1233

$self->log("FAILED [dpkg-source died]\n");

1234

Sbuild::Exception::Build->throw(error => "FAILED [dpkg-source died]",

1235

failstage => "unpack");

1236

}

1237

1238

$self->get('Session')->run_command(

1239

{ COMMAND => ['chmod', '-R', 'g-s,go+rX', $dscdir],

1240

USER => $self->get_conf('BUILD_USER'),

1241

PRIORITY => 0});

1242

if ($?) {

1243

$self->log("chmod -R g-s,go+rX $dscdir failed.\n");

1244

Sbuild::Exception::Build->throw(error => "chmod -R g-s,go+rX $dscdir failed",

1245

failstage => "unpack");

1246

}

1247

1248

$dscdir = "$build_dir/$dscdir"

1249

}

1250

else {

1251

$dscdir = "$build_dir/$dscdir";

1252

1253

$self->log_subsubsection("Check unpacked source");

1254

# check if the unpacked tree is really the version we need

1255

$dscdir = $self->get('Session')->strip_chroot_path($dscdir);

1256

my $pipe = $self->get('Session')->pipe_command(

1257

{ COMMAND => ['dpkg-parsechangelog'],

1258

USER => $self->get_conf('BUILD_USER'),

1259

PRIORITY => 0,

1260

DIR => $dscdir});

1261

$self->set('Sub Task', "dpkg-parsechangelog");

1262

1263

my $clog = "";

1264

while(<$pipe>) {

1265

$clog .= $_;

1266

}

1267

close($pipe);

1268

if ($?) {

1269

$self->log("FAILED [dpkg-parsechangelog died]\n");

1270

Sbuild::Exception::Build->throw(error => "FAILED [dpkg-parsechangelog died]",

1271

failstage => "check-unpacked-version");

1272

}

1273

if ($clog !~ /^Version:\s*(.+)\s*$/mi) {

1274

$self->log("dpkg-parsechangelog didn't print Version:\n");

1275

Sbuild::Exception::Build->throw(error => "dpkg-parsechangelog didn't print Version:",

1276

failstage => "check-unpacked-version");

1277

}

1278

}

1279

1280

$self->log_subsubsection("Check disc space");

1281

my $current_usage = `du -k -s "$dscdir"`;

1282

$current_usage =~ /^(\d+)/;

1283

$current_usage = $1;

1284

if ($current_usage) {

1285

my $free = df($dscdir);

1286

if ($free < 2*$current_usage && $self->get_conf('CHECK_SPACE')) {

1287

Sbuild::Exception::Build->throw(error => "Disc space is probably not sufficient for building.",

1288

info => "Source needs $current_usage KiB, while $free KiB is free.)",

1289

failstage => "check-space");

1290

} else {

1291

$self->log("Sufficient free space for build\n");

1292

}

1293

}

1294

1295

my $cpipe = $self->get('Session')->pipe_command(

1296

{ COMMAND => ['dpkg-parsechangelog'],

1297

USER => $self->get_conf('BUILD_USER'),

1298

PRIORITY => 0,

1299

DIR => $self->get('Session')->strip_chroot_path($dscdir) });

1300

my $clog = do { local $/; <$cpipe> };

1301

close($cpipe);

1302

if ($?) {

1303

$self->log("FAILED [dpkg-parsechangelog died]\n");

1304

return 0;

1305

}

1306

1307

my ($name) = $clog =~ /^Source:\s*(.*)$/m;

1308

my ($version) = $clog =~ /^Version:\s*(.*)$/m;

1309

my ($dists) = $clog =~ /^Distribution:\s*(.*)$/m;

1310

my ($urgency) = $clog =~ /^Urgency:\s*(.*)$/m;

1311

my ($date) = $clog =~ /^Date:\s*(.*)$/m;

1312

if ($dists ne $self->get_conf('DISTRIBUTION')) {

1313

$self->build_log_colour('yellow',

1314

"^Distribution: " . $self->get_conf('DISTRIBUTION') . "\$");

1315

}

1316

1317

if ($self->get_conf('BIN_NMU') || $self->get_conf('APPEND_TO_VERSION')) {

1318

if (!$self->get_conf('MAINTAINER_NAME')) {

1319

Sbuild::Exception::Build->throw(error => "No maintainer specified.",

1320

info => 'When making changelog additions for a binNMU or appending a version suffix, a maintainer must be specified for the changelog entry e.g. using $maintainer_name, $uploader_name or $key_id, (or the equivalent command-line options)',

1321

failstage => "check-space");

1322

}

1323

1324

$self->log_subsubsection("Hack binNMU version");

1325

if (open( F, "<$dscdir/debian/changelog" )) {

1326

my $text = do { local $/; <F> };

1327

close( F );

1328

1329

1330

my $NMUversion = $self->get('Version');

1331

if (!open( F, ">$dscdir/debian/changelog" )) {

1332

$self->log("Can't open debian/changelog for binNMU hack: $!\n");

1333

Sbuild::Exception::Build->throw(error => "Can't open debian/changelog for binNMU hack: $!",

1334

failstage => "hack-binNMU");

1335

}

1336

$dists = $self->get_conf('DISTRIBUTION');

1337

1338

print F "$name ($NMUversion) $dists; urgency=low\n\n";

1339

if ($self->get_conf('APPEND_TO_VERSION')) {

1340

print F " * Append ", $self->get_conf('APPEND_TO_VERSION'),

1341

" to version number; no source changes\n";

1342

}

1343

if ($self->get_conf('BIN_NMU')) {

1344

print F " * Binary-only non-maintainer upload for $arch; ",

1345

"no source changes.\n";

1346

print F " * ", join( " ", split( "\n", $self->get_conf('BIN_NMU') )), "\n";

1347

}

1348

print F "\n";

1349

1350

print F " -- " . $self->get_conf('MAINTAINER_NAME') . " $date\n\n";

1351

print F $text;

1352

close( F );

1353

$self->log("Created changelog entry for binNMU version $NMUversion\n");

1354

}

1355

else {

1356

$self->log("Can't open debian/changelog -- no binNMU hack!\n");

1357

Sbuild::Exception::Build->throw(error => "Can't open debian/changelog -- no binNMU hack: $!!",

1358

failstage => "hack-binNMU");

1359

}

1360

}

1361

1362

if (-f "$dscdir/debian/files") {

1363

local( *FILES );

1364

my @lines;

1365

open( FILES, "<$dscdir/debian/files" );

1366

chomp( @lines = <FILES> );

1367

close( FILES );

1368

@lines = map { my $ind = 76-length($_);

1369

$ind = 0 if $ind < 0;

1370

"│ $_".(" " x $ind). " │\n"; } @lines;

1371

1372

$self->log_warning("After unpacking, there exists a file debian/files with the contents:\n");

1373

1374

$self->log('┌', '─'x78, '┐', "\n");

1375

foreach (@lines) {

1376

$self->log($_);

1377

}

1378

$self->log('└', '─'x78, '┘', "\n");

1379

1380

$self->log_info("This should be reported as a bug.\n");

1381

$self->log_info("The file has been removed to avoid dpkg-genchanges errors.\n");

1382

1383

unlink "$dscdir/debian/files";

1384

}

1385

1386

# Build tree not writable during build (except for the sbuild

1387

# user performing the build).

1388

$self->get('Session')->run_command(

1389

{ COMMAND => ['chmod', '-R', 'go-w', $self->get('Build Dir')],

1390

USER => 'root',

1391

PRIORITY => 0});

1392

if ($?) {

1393

$self->log("chmod og-w " . $self->get('Build Dir') . " failed.\n");

1394

return 0;

1395

}

1396

1397

$self->set('Build Start Time', time);

1398

$self->set('Build End Time', $self->get('Build Start Time'));

1399

1400

my $binopt = $self->get_conf('BUILD_SOURCE') ?

1401

$self->get_conf('FORCE_ORIG_SOURCE') ? "-sa" : "" :

1402

$self->get_conf('BUILD_ARCH_ALL') ? "-b" : "-B";

1403

1404

my $bdir = $self->get('Session')->strip_chroot_path($dscdir);

1405

if (-f "$self->{'Chroot Dir'}/etc/ld.so.conf" &&

1406

! -r "$self->{'Chroot Dir'}/etc/ld.so.conf") {

1407

$self->get('Session')->run_command(

1408

{ COMMAND => ['chmod', 'a+r', '/etc/ld.so.conf'],

1409

USER => 'root',

1410

PRIORITY => 0,

1411

DIR => '/' });

1412

1413

$self->log_subsubsection("Fix ld.so");

1414

$self->log("ld.so.conf was not readable! Fixed.\n");

1415

}

1416

1417

my $buildcmd = [];

1418

push (@{$buildcmd}, $self->get_conf('BUILD_ENV_CMND'))

1419

if (defined($self->get_conf('BUILD_ENV_CMND')) &&

1420

$self->get_conf('BUILD_ENV_CMND'));

1421

push (@{$buildcmd}, 'dpkg-buildpackage');

1422

1423

if (defined($self->get_conf('PGP_OPTIONS')) &&

1424

$self->get_conf('PGP_OPTIONS')) {

1425

if (ref($self->get_conf('PGP_OPTIONS')) eq 'ARRAY') {

1426

push (@{$buildcmd}, @{$self->get_conf('PGP_OPTIONS')});

1427

} else {

1428

push (@{$buildcmd}, $self->get_conf('PGP_OPTIONS'));

1429

}

1430

}

1431

1432

if (defined($self->get_conf('SIGNING_OPTIONS')) &&

1433

$self->get_conf('SIGNING_OPTIONS')) {

1434

if (ref($self->get_conf('SIGNING_OPTIONS')) eq 'ARRAY') {

1435

push (@{$buildcmd}, @{$self->get_conf('SIGNING_OPTIONS')});

1436

} else {

1437

push (@{$buildcmd}, $self->get_conf('SIGNING_OPTIONS'));

1438

}

1439

}

1440

1441

push (@{$buildcmd}, $binopt) if $binopt;

1442

push (@{$buildcmd}, "-r" . $self->get_conf('FAKEROOT'));

1443

1444

if (defined($self->get_conf('DPKG_BUILDPACKAGE_USER_OPTIONS')) &&

1445

$self->get_conf('DPKG_BUILDPACKAGE_USER_OPTIONS')) {

1446

push (@{$buildcmd}, @{$self->get_conf('DPKG_BUILDPACKAGE_USER_OPTIONS')});

1447

}

1448

1449

# Set up additional build environment variables.

1450

my %buildenv = %{$self->get_conf('BUILD_ENVIRONMENT')};

1451

$buildenv{'PATH'} = $self->get_conf('PATH');

1452

$buildenv{'LD_LIBRARY_PATH'} = $self->get_conf('LD_LIBRARY_PATH')

1453

if defined($self->get_conf('LD_LIBRARY_PATH'));

1454

1455

# Explicitly add any needed environment to the environment filter

1456

# temporarily for dpkg-buildpackage.

1457

my @env_filter;

1458

foreach my $envvar (keys %buildenv) {

1459

push(@env_filter, "^$envvar\$");

1460

}

1461

1462

# Dump build environment

1463

$self->log_subsubsection("User Environment");

1464

{

1465

my $pipe = $self->get('Session')->pipe_command(

1466

{ COMMAND => ['env'],

1467

ENV => \%buildenv,

1468

ENV_FILTER => \@env_filter,

1469

USER => $self->get_conf('BUILD_USER'),

1470

SETSID => 1,

1471

PRIORITY => 0,

1472

DIR => $bdir

1473

});

1474

1475

my (@lines) = <$pipe>;

1476

close($pipe);

1477

1478

@lines=sort(@lines);

1479

foreach my $line (@lines) {

1480

# $line contains a trailing newline, so don't add one.

1481

$self->log($line);

1482

}

1483

}

1484

1485

$self->log_subsubsection("dpkg-buildpackage");

1486

1487

my $command = {

1488

COMMAND => $buildcmd,

1489

ENV => \%buildenv,

1490

ENV_FILTER => \@env_filter,

1491

USER => $self->get_conf('BUILD_USER'),

1492

SETSID => 1,

1493

PRIORITY => 0,

1494

DIR => $bdir

1495

};

1496

1497

my $pipe = $self->get('Session')->pipe_command($command);

1498

1499

$self->set('Sub Task', "dpkg-buildpackage");

1500

1501

# We must send the signal as root, because some subprocesses of

1502

# dpkg-buildpackage could run as root. So we have to use a shell

1503

# command to send the signal... but /bin/kill can't send to

1504

# process groups :-( So start another Perl :-)

1505

my $timeout = $self->get_conf('INDIVIDUAL_STALLED_PKG_TIMEOUT')->{$pkg} ||

1506

$self->get_conf('STALLED_PKG_TIMEOUT');

1507

$timeout *= 60;

1508

my $timed_out = 0;

1509

my(@timeout_times, @timeout_sigs, $last_time);

1510

1511

local $SIG{'ALRM'} = sub {

1512

my $pid = $command->{'PID'};

1513

my $signal = ($timed_out > 0) ? "KILL" : "TERM";

1514

$self->get('Session')->run_command(

1515

{ COMMAND => ['perl',

1516

'-e',

1517

"kill( \"$signal\", -$pid )"],

1518

USER => 'root',

1519

PRIORITY => 0,

1520

DIR => '/' });

1521

1522

$timeout_times[$timed_out] = time - $last_time;

1523

$timeout_sigs[$timed_out] = $signal;

1524

$timed_out++;

1525

$timeout = 5*60; # only wait 5 minutes until next signal

1526

};

1527

1528

alarm($timeout);

1529

while(<$pipe>) {

1530

alarm($timeout);

1531

$last_time = time;

1532

if ($self->get('ABORT')) {

1533

my $pid = $command->{'PID'};

1534

$self->get('Session')->run_command(

1535

{ COMMAND => ['perl',

1536

'-e',

1537

"kill( \"TERM\", -$pid )"],

1538

USER => 'root',

1539

PRIORITY => 0,

1540

DIR => '/' });

1541

}

1542

$self->log($_);

1543

}

1544

close($pipe);

1545

alarm(0);

1546

$rv = $?;

1547

1548

my $i;

1549

for( $i = 0; $i < $timed_out; ++$i ) {

1550

$self->log("Build killed with signal " . $timeout_sigs[$i] .

1551

" after " . int($timeout_times[$i]/60) .

1552

" minutes of inactivity\n");

1553

}

1554

$self->set('Build End Time', time);

1555

$self->set('Pkg End Time', time);

1556

$self->write_stats('build-time',

1557

$self->get('Build End Time')-$self->get('Build Start Time'));

1558

$self->write_stats('install-download-time',

1559

$self->get('Install End Time')-$self->get('Install Start Time'));

1560

my $finish_date = strftime("%Y%m%d-%H%M",localtime($self->get('Build End Time')));

1561

$self->log_sep();

1562

$self->log("Build finished at $finish_date\n");

1563

1564

my @space_files = ("$dscdir");

1565

1566

$self->log_subsubsection("Finished");

1567

if ($rv) {

1568

$self->log_error("Build failure (dpkg-buildpackage died)\n");

1569

} else {

1570

$self->log_info("Built successfully\n");

1571

1572

if (-r "$dscdir/debian/files" && $self->get('Chroot Build Dir')) {

1573

my @files = $self->debian_files_list("$dscdir/debian/files");

1574

1575

foreach (@files) {

1576

if (! -f "$build_dir/$_") {

1577

$self->log_error("Package claims to have built ".basename($_).", but did not. This is a bug in the packaging.\n");

1578

next;

1579

}

1580

if (/_all.u?deb$/ and not $self->get_conf('BUILD_ARCH_ALL')) {

1581

$self->log_error("Package builds ".basename($_)." when binary-indep target is not called. This is a bug in the packaging.\n");

1582

unlink("$build_dir/$_");

1583

next;

1584

}

1585

}

1586

}

1587

1588

1589

# Restore write access to build tree now build is complete.

1590

$self->get('Session')->run_command(

1591

{ COMMAND => ['chmod', '-R', 'g+w', $self->get('Build Dir')],

1592

USER => 'root',

1593

PRIORITY => 0});

1594

if ($?) {

1595

$self->log("chmod g+w " . $self->get('Build Dir') . " failed.\n");

1596

return 0;

1597

}

1598

1599

$self->log_subsection("Changes");

1600

$changes = $self->get('Package_SVersion') . "_$arch.changes";

1601

my @cfiles;

1602

if (-r "$build_dir/$changes") {

1603

my(@do_dists, @saved_dists);

1604

$self->log_subsubsection("$changes:");

1605

open( F, "<$build_dir/$changes" );

1606

my $sys_build_dir = $self->get_conf('BUILD_DIR');

1607

if (open( F2, ">$sys_build_dir/$changes.new" )) {

1608

while( <F> ) {

1609

if (/^Distribution:\s*(.*)\s*$/ and $self->get_conf('OVERRIDE_DISTRIBUTION')) {

1610

$self->log("Distribution: " . $self->get_conf('DISTRIBUTION') . "\n");

1611

print F2 "Distribution: " . $self->get_conf('DISTRIBUTION') . "\n";

1612

}

1613

else {

1614

print F2 $_;

1615

while (length $_ > 989)

1616

{

1617

my $index = rindex($_,' ',989);

1618

$self->log(substr ($_,0,$index) . "\n");

1619

$_ = ' ' . substr ($_,$index+1);

1620

}

1621

$self->log($_);

1622

if (/^ [a-z0-9]{32}/) {

1623

push(@cfiles, (split( /\s+/, $_ ))[5] );

1624

}

1625

}

1626

}

1627

close( F2 );

1628

rename("$sys_build_dir/$changes.new", "$sys_build_dir/$changes")

1629

or $self->log("$sys_build_dir/$changes.new could not be " .

1630

"renamed to $sys_build_dir/$changes: $!\n");

1631

$self->set('Changes File', "$sys_build_dir/$changes");

1632

unlink("$build_dir/$changes")

1633

if $build_dir;

1634

}

1635

else {

1636

$self->log("Cannot create $sys_build_dir/$changes.new: $!\n");

1637

$self->log("Distribution field may be wrong!!!\n");

1638

if ($build_dir) {

1639

system "mv", "-f", "$build_dir/$changes", "."

1640

and $self->log_error("Could not move ".basename($_)." to .\n");

1641

}

1642

}

1643

close( F );

1644

}

1645

else {

1646

$self->log("Can't find $changes -- can't dump info\n");

1647

}

1648

1649

$self->log_subsection("Package contents");

1650

1651

my @debcfiles = @cfiles;

1652

foreach (@debcfiles) {

1653

my $deb = "$build_dir/$_";

1654

next if $deb !~ /(\Q$arch\E|all)\.[\w\d.-]*$/;

1655

1656

$self->log_subsubsection("$_");

1657

if (!open( PIPE, "dpkg --info $deb 2>&1 |" )) {

1658

$self->log("Can't spawn dpkg: $! -- can't dump info\n");

1659

}

1660

else {

1661

$self->log($_) while( <PIPE> );

1662

close( PIPE );

1663

}

1664

$self->log("\n");

1665

if (!open( PIPE, "dpkg --contents $deb 2>&1 |" )) {

1666

$self->log("Can't spawn dpkg: $! -- can't dump info\n");

1667

}

1668

else {

1669

$self->log($_) while( <PIPE> );

1670

close( PIPE );

1671

}

1672

$self->log("\n");

1673

}

1674

1675

foreach (@cfiles) {

1676

push( @space_files, $self->get_conf('BUILD_DIR') . "/$_");

1677

system "mv", "-f", "$build_dir/$_", $self->get_conf('BUILD_DIR')

1678

and $self->log_error("Could not move $_ to .\n");

1679

}

1680

}

1681

1682

$self->check_watches();

1683

$self->check_space(@space_files);

1684

1685

return $rv == 0 ? 1 : 0;

1686

}

1687

1688

# Produce a hash suitable for ENV export

1689

sub get_env ($$) {

1690

my $self = shift;

1691

my $prefix = shift;

1692

1693

sub _env_loop ($$$$) {

1694

my ($env,$ref,$keysref,$prefix) = @_;

1695

1696

foreach my $key (keys( %{ $keysref } )) {

1697

my $value = $ref->get($key);

1698

next if (!defined($value));

1699

next if (ref($value));

1700

my $name = "${prefix}${key}";

1701

$name =~ s/ /_/g;

1702

$env->{$name} = $value;

1703

}

1704

}

1705

1706

my $envlist = {};

1707

_env_loop($envlist, $self, $self, $prefix);

1708

_env_loop($envlist, $self->get('Config'), $self->get('Config')->{'KEYS'}, "${prefix}CONF_");

1709

return $envlist;

1710

}

1711

1712

sub read_build_essential {

1713

my $self = shift;

1714

my @essential;

1715

local (*F);

1716

1717

if (open( F, "$self->{'Chroot Dir'}/usr/share/doc/build-essential/essential-packages-list" )) {

1718

while( <F> ) {

1719

last if $_ eq "\n";

1720

}

1721

while( <F> ) {

1722

chomp;

1723

push( @essential, $_ ) if $_ !~ /^\s*$/;

1724

}

1725

close( F );

1726

}

1727

else {

1728

warn "Cannot open $self->{'Chroot Dir'}/usr/share/doc/build-essential/essential-packages-list: $!\n";

1729

}

1730

1731

if (open( F, "$self->{'Chroot Dir'}/usr/share/doc/build-essential/list" )) {

1732

while( <F> ) {

1733

last if $_ eq "BEGIN LIST OF PACKAGES\n";

1734

}

1735

while( <F> ) {

1736

chomp;

1737

last if $_ eq "END LIST OF PACKAGES";

1738

next if /^\s/ || /^$/;

1739

push( @essential, $_ );

1740

}

1741

close( F );

1742

}

1743

else {

1744

warn "Cannot open $self->{'Chroot Dir'}/usr/share/doc/build-essential/list: $!\n";

1745

}

1746

1747

# Workaround http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=602571

1748

# Also works around Ubuntu Lucid shipping with "diff" instead of

1749

# "diffutils": https://bugs.launchpad.net/ubuntu/+source/sbuild/+bug/741897

1750

if (open( F, "$self->{'Chroot Dir'}/etc/lsb-release" )) {

1751

while( <F> ) {

1752

if ($_ eq "DISTRIB_ID=Ubuntu\n") {

1753

@essential = grep(!/^sysvinit$/, @essential);

1754

}

1755

if ($_ eq "DISTRIB_CODENAME=lucid\n") {

1756

s/^diff$/diffutils/ for (@essential);

1757

}

1758

}

1759

close( F );

1760

}

1761

1762

return join( ", ", @essential );

1763

}

1764

1765

sub check_space {

1766

my $self = shift;

1767

my @files = @_;

1768

my $sum = 0;

1769

1770

foreach (@files) {

1771

my $pipe = $self->get('Host')->pipe_command(

1772

{ COMMAND => ['du', '-k', '-s', $_],

1773

USER => $self->get_conf('USERNAME'),

1774

PRIORITY => 0,

1775

DIR => '/'});

1776

1777

if (!$pipe) {

1778

$self->log("Cannot determine space needed (du failed): $!\n");

1779

return;

1780

}

1781

while(<$pipe>) {

1782

next if !/^(\d+)/;

1783

$sum += $1;

1784

}

1785

close($pipe);

1786

}

1787

1788

$self->set('This Time', $self->get('Pkg End Time') - $self->get('Pkg Start Time'));

1789

$self->get('This Time') = 0 if $self->get('This Time') < 0;

1790

$self->set('This Space', $sum);

1791

}

1792

1793

sub prepare_watches {

1794

my $self = shift;

1795

my @instd = @_;

1796

my($pkg, $prg);

1797

1798

# init %this_watches to names of packages which have not been

1799

# installed as source dependencies

1800

$self->set('This Watches', {});

1801

foreach $pkg (keys %{$self->get_conf('WATCHES')}) {

1802

if (isin( $pkg, @instd )) {

1803

debug("Excluding from watch: $pkg\n");

1804

next;

1805

}

1806

foreach $prg (@{$self->get_conf('WATCHES')->{$pkg}}) {

1807

# Add /usr/bin to programs without a path

1808

$prg = "/usr/bin/$prg" if $prg !~ m,^/,;

1809

$self->get('This Watches')->{"$self->{'Chroot Dir'}$prg"} = $pkg;

1810

debug("Will watch for $prg ($pkg)\n");

1811

}

1812

}

1813

}

1814

1815

sub check_watches {

1816

my $self = shift;

1817

my($prg, @st, %used);

1818

1819

return if (!$self->get_conf('CHECK_WATCHES'));

1820

1821

foreach $prg (keys %{$self->get('This Watches')}) {

1822

if (!(@st = stat( $prg ))) {

1823

debug("Watch: $prg: stat failed\n");

1824

next;

1825

}

1826

if ($st[8] > $self->get('Build Start Time')) {

1827

my $pkg = $self->get('This Watches')->{$prg};

1828

my $prg2 = $self->get('Session')->strip_chroot_path($prg);

1829

push( @{$used{$pkg}}, $prg2 );

1830

}

1831

else {

1832

debug("Watch: $prg: untouched\n");

1833

}

1834

}

1835

return if !%used;

1836

1837

$self->log_warning("NOTE: Binaries from the following packages (access time changed) used\nwithout a source dependency:");

1838

1839

foreach (keys %used) {

1840

$self->log(" $_: @{$used{$_}}\n");

1841

}

1842

$self->log("\n");

1843

}

1844

1845

sub lock_file {

1846

my $self = shift;

1847

my $file = shift;

1848

my $for_srcdep = shift;

1849

my $lockfile = "$file.lock";

1850

my $try = 0;

1851

1852

repeat:

1853

if (!sysopen( F, $lockfile, O_WRONLY|O_CREAT|O_TRUNC|O_EXCL, 0644 )){

1854

if ($! == EEXIST) {

1855

# lock file exists, wait

1856

goto repeat if !open( F, "<$lockfile" );

1857

my $line = <F>;

1858

my ($pid, $user);

1859

close( F );

1860

if ($line !~ /^(\d+)\s+([\w\d.-]+)$/) {

1861

$self->log_warning("Bad lock file contents ($lockfile) -- still trying\n");

1862

}

1863

else {

1864

($pid, $user) = ($1, $2);

1865

if (kill( 0, $pid ) == 0 && $! == ESRCH) {

1866

# process doesn't exist anymore, remove stale lock

1867

$self->log_warning("Removing stale lock file $lockfile ".

1868

"(pid $pid, user $user)\n");

1869

unlink( $lockfile );

1870

goto repeat;

1871

}

1872

}

1873

++$try;

1874

if (!$for_srcdep && $try > $self->get_conf('MAX_LOCK_TRYS')) {

1875

$self->log_warning("Lockfile $lockfile still present after " .

1876

$self->get_conf('MAX_LOCK_TRYS') *

1877

$self->get_conf('LOCK_INTERVAL') .

1878

" seconds -- giving up\n");

1879

return;

1880

}

1881

$self->log("Another sbuild process ($pid by $user) is currently installing or removing packages -- waiting...\n")

1882

if $for_srcdep && $try == 1;

1883

sleep $self->get_conf('LOCK_INTERVAL');

1884

goto repeat;

1885

}

1886

$self->log_warning("Can't create lock file $lockfile: $!\n");

1887

}

1888

1889

my $username = $self->get_conf('USERNAME');

1890

F->print("$$ $username\n");

1891

F->close();

1892

}

1893

1894

sub unlock_file {

1895

my $self = shift;

1896

my $file = shift;

1897

my $lockfile = "$file.lock";

1898

1899

unlink( $lockfile );

1900

}

1901

1902

sub add_stat {

1903

my $self = shift;

1904

my $key = shift;

1905

my $value = shift;

1906

1907

$self->get('Summary Stats')->{$key} = $value;

1908

}

1909

1910

sub generate_stats {

1911

my $self = shift;

1912

1913

$self->add_stat('Job', $self->get('Job'));

1914

$self->add_stat('Package', $self->get('Package'));

1915

$self->add_stat('Version', $self->get('Version'));

1916

$self->add_stat('Source-Version', $self->get('OVersion'));

1917

$self->add_stat('Architecture', $self->get('Arch'));

1918

$self->add_stat('Distribution', $self->get_conf('DISTRIBUTION'));

1919

$self->add_stat('Space', $self->get('This Space'));

1920

$self->add_stat('Build-Time',

1921

$self->get('Build End Time')-$self->get('Build Start Time'));

1922

$self->add_stat('Install-Time',

1923

$self->get('Install End Time')-$self->get('Install Start Time'));

1924

$self->add_stat('Package-Time',

1925

$self->get('Pkg End Time')-$self->get('Pkg Start Time'));

1926

$self->add_stat('Build-Space', $self->get('This Space'));

1927

$self->add_stat('Status', $self->get_status());

1928

$self->add_stat('Fail-Stage', $self->get('Pkg Fail Stage'))

1929

if ($self->get_status() ne "successful");

1930

$self->add_stat('Lintian', $self->get('Lintian Reason'))

1931

if $self->get('Lintian Reason');

1932

$self->add_stat('Piuparts', $self->get('Piuparts Reason'))

1933

if $self->get('Piuparts Reason');

1934

}

1935

1936

sub log_stats {

1937

my $self = shift;

1938

foreach my $stat (sort keys %{$self->get('Summary Stats')}) {

1939

$self->log("${stat}: " . $self->get('Summary Stats')->{$stat} . "\n");

1940

}

1941

}

1942

1943

sub print_stats {

1944

my $self = shift;

1945

foreach my $stat (sort keys %{$self->get('Summary Stats')}) {

1946

print STDOUT "${stat}: " . $self->get('Summary Stats')->{$stat} . "\n";

1947

}

1948

}

1949

1950

sub write_stats {

1951

my $self = shift;

1952

1953

return if (!$self->get_conf('BATCH_MODE'));

1954

1955

my $stats_dir = $self->get_conf('STATS_DIR');

1956

1957

return if not defined $stats_dir;

1958

1959

if (! -d $stats_dir &&

1960

!mkdir $stats_dir) {

1961

$self->log_warning("Could not create $stats_dir: $!\n");

1962

return;

1963

}

1964

1965

my ($cat, $val) = @_;

1966

local( *F );

1967

1968

$self->lock_file($stats_dir, 0);

1969

open( F, ">>$stats_dir/$cat" );

1970

print F "$val\n";

1971

close( F );

1972

$self->unlock_file($stats_dir);

1973

}

1974

1975

sub debian_files_list {

1976

my $self = shift;

1977

my $files = shift;

1978

1979

my @list;

1980

1981

debug("Parsing $files\n");

1982

1983

if (-r $files && open( FILES, "<$files" )) {

1984

while (<FILES>) {

1985

chomp;

1986

my $f = (split( /\s+/, $_ ))[0];

1987

push( @list, "$f" );

1988

debug(" $f\n");

1989

}

1990

close( FILES ) or $self->log("Failed to close $files\n") && return 1;

1991

}

1992

1993

return @list;

1994

}

1995

1996

# Figure out chroot architecture

1997

sub chroot_arch {

1998

my $self = shift;

1999

2000

my $pipe = $self->get('Session')->pipe_command(

2001

{ COMMAND => ['dpkg', '--print-architecture'],

2002

USER => $self->get_conf('BUILD_USER'),

2003

PRIORITY => 0,

2004

DIR => '/' }) || return undef;

2005

2006

chomp(my $chroot_arch = <$pipe>);

2007

close($pipe);

2008

2009

Sbuild::Exception::Build->throw(error => "Can't determine architecture of chroot: $!",

2010

failstage => "chroot-arch")

2011

if ($? || !defined($chroot_arch));

2012

2013

return $chroot_arch;

2014

}

2015

2016

sub build_log_filter {

2017

my $self = shift;

2018

my $text = shift;

2019

my $replacement = shift;

2020

2021

if ($self->get_conf('LOG_FILTER')) {

2022

$self->log($self->get('FILTER_PREFIX') . $text . ':' . $replacement . "\n");

2023

}

2024

}

2025

2026

sub build_log_colour {

2027

my $self = shift;

2028

my $regex = shift;

2029

my $colour = shift;

2030

2031

if ($self->get_conf('LOG_COLOUR')) {

2032

$self->log($self->get('COLOUR_PREFIX') . $colour . ':' . $regex . "\n");

2033

}

2034

}

2035

2036

sub open_build_log {

2037

my $self = shift;

2038

2039

my $date = strftime("%Y%m%d-%H%M", localtime($self->get('Pkg Start Time')));

2040

2041

my $filter_prefix = '__SBUILD_FILTER_' . $$ . ':';

2042

$self->set('FILTER_PREFIX', $filter_prefix);

2043

my $colour_prefix = '__SBUILD_COLOUR_' . $$ . ':';

2044

$self->set('COLOUR_PREFIX', $colour_prefix);

2045

2046

my $filename = $self->get_conf('LOG_DIR') . '/' .

2047

$self->get('Package_SVersion') . '-' .

2048

$self->get('Arch') .

2049

"-$date";

2050

2051

open($saved_stdout, ">&STDOUT") or warn "Can't redirect stdout\n";

2052

open($saved_stderr, ">&STDERR") or warn "Can't redirect stderr\n";

2053

2054

my $PLOG;

2055

2056

my $pid;

2057

($pid = open($PLOG, "|-"));

2058

if (!defined $pid) {

2059

warn "Cannot open pipe to '$filename': $!\n";

2060

} elsif ($pid == 0) {

2061

$SIG{'INT'} = 'IGNORE';

2062

$SIG{'TERM'} = 'IGNORE';

2063

$SIG{'QUIT'} = 'IGNORE';

2064

$SIG{'PIPE'} = 'IGNORE';

2065

2066

$PROGRAM_NAME = 'package log for ' . $self->get('Package_SVersion') . '_' . $self->get('Arch');

2067

2068

if (!$self->get_conf('NOLOG') &&

2069

$self->get_conf('LOG_DIR_AVAILABLE')) {

2070

open( CPLOG, ">$filename" ) or

2071

Sbuild::Exception::Build->throw(error => "Failed to open build log $filename: $!",

2072

failstage => "init");

2073

CPLOG->autoflush(1);

2074

$saved_stdout->autoflush(1);

2075

2076

# Create 'current' symlinks

2077

if ($self->get_conf('SBUILD_MODE') eq 'buildd') {

2078

$self->log_symlink($filename,

2079

$self->get_conf('BUILD_DIR') . '/current-' .

2080

$self->get_conf('DISTRIBUTION'));

2081

} else {

2082

$self->log_symlink($filename,

2083

$self->get_conf('BUILD_DIR') . '/' .

2084

$self->get('Package_SVersion') . '_' .

2085

$self->get('Arch') . '.build');

2086

}

2087

}

2088

2089

# Cache vars to avoid repeated hash lookups.

2090

my $nolog = $self->get_conf('NOLOG');

2091

my $log = $self->get_conf('LOG_DIR_AVAILABLE');

2092

my $verbose = $self->get_conf('VERBOSE');

2093

my $log_colour = $self->get_conf('LOG_COLOUR');

2094

my @filter = ();

2095

my @colour = ();

2096

my ($text, $replacement);

2097

my $filter_regex = "^$filter_prefix(.*):(.*)\$";

2098

my $colour_regex = "^$colour_prefix(.*):(.*)\$";

2099

my @ignore = ();

2100

2101

while (<STDIN>) {

2102

# Add a replacement pattern to filter (sent from main

2103

# process in log stream).

2104

if (m/$filter_regex/) {

2105

($text,$replacement)=($1,$2);

2106

$replacement = "«$replacement»";

2107

push (@filter, [$text, $replacement]);

2108

$_ = "I: NOTICE: Log filtering will replace '$text' with '$replacement'\n";

2109

} elsif (m/$colour_regex/) {

2110

my ($colour, $regex);

2111

($colour,$regex)=($1,$2);

2112

push (@colour, [$colour, $regex]);

2113

# $_ = "I: NOTICE: Log colouring will colour '$regex' in $colour\n";

2114

next;

2115

} else {

2116

# Filter out any matching patterns

2117

foreach my $pattern (@filter) {

2118

($text,$replacement) = @{$pattern};

2119

s/$text/$replacement/g;

2120

}

2121

}

2122

if (m/Deprecated key/ || m/please update your configuration/) {

2123

my $skip = 0;

2124

foreach my $ignore (@ignore) {

2125

$skip = 1 if ($ignore eq $_);

2126

}

2127

next if $skip;

2128

push(@ignore, $_);

2129

}

2130

2131

if ($nolog || $verbose) {

2132

if (-t $saved_stdout && $log_colour) {

2133

my $colour = 'reset';

2134

foreach my $pattern (@colour) {

2135

if (m/$$pattern[0]/) {

2136

$colour = $$pattern[1];

2137

}

2138

}

2139

print $saved_stdout color $colour;

2140

}

2141

2142

print $saved_stdout $_;

2143

if (-t $saved_stdout && $log_colour) {

2144

print $saved_stdout color 'reset';

2145

}

2146

2147

# Manual flushing due to Perl 5.10 bug. Should autoflush.

2148

$saved_stdout->flush();

2149

}

2150

if (!$nolog && $log) {

2151

print CPLOG $_;

2152

}

2153

}

2154

2155

close CPLOG;

2156

exit 0;

2157

}

2158

2159

$PLOG->autoflush(1);

2160

open(STDOUT, '>&', $PLOG) or warn "Can't redirect stdout\n";

2161

open(STDERR, '>&', $PLOG) or warn "Can't redirect stderr\n";

2162

$self->set('Log File', $filename);

2163

$self->set('Log Stream', $PLOG);

2164

2165

my $hostname = $self->get_conf('HOSTNAME');

2166

$self->log("sbuild (Debian sbuild) $version ($release_date) on $hostname\n");

2167

2168

my $head1 = $self->get('Package') . ' ' . $self->get('Version') .

2169

' (' . $self->get('Arch') . ') ';

2170

my $head2 = strftime("%d %b %Y %H:%M",

2171

localtime($self->get('Pkg Start Time')));

2172

my $head = $head1 . ' ' x (80 - 4 - length($head1) - length($head2)) .

2173

$head2;

2174

$self->log_section($head);

2175

2176

$self->log("Package: " . $self->get('Package') . "\n");

2177

$self->log("Version: " . $self->get('Version') . "\n");

2178

$self->log("Source Version: " . $self->get('OVersion') . "\n");

2179

$self->log("Distribution: " . $self->get_conf('DISTRIBUTION') . "\n");

2180

$self->log("Architecture: " . $self->get('Arch') . "\n");

2181

$self->log("\n");

2182

}

2183

2184

sub close_build_log {

2185

my $self = shift;

2186

2187

my $time = $self->get('Pkg End Time');

2188

if ($time == 0) {

2189

$time = time;

2190

}

2191

my $date = strftime("%Y%m%d-%H%M", localtime($time));

2192

2193

if ($self->get_status() eq "successful") {

2194

$self->add_time_entry($self->get('Package_Version'), $self->get('This Time'));

2195

$self->add_space_entry($self->get('Package_Version'), $self->get('This Space'));

2196

}

2197

2198

my $hours = int($self->get('This Time')/3600);

2199

my $minutes = int(($self->get('This Time')%3600)/60),

2200

my $seconds = int($self->get('This Time')%60),

2201

my $space = $self->get('This Space');

2202

2203

my $filename = $self->get('Log File');

2204

2205

# building status at this point means failure.

2206

if ($self->get_status() eq "building") {

2207

$self->set_status('failed');

2208

}

2209

2210

$self->log_subsection('Summary');

2211

$self->generate_stats();

2212

$self->log_stats();

2213

2214

$self->log_sep();

2215

$self->log("Finished at ${date}\n");

2216

$self->log(sprintf("Build needed %02d:%02d:%02d, %dk disc space\n",

2217

$hours, $minutes, $seconds, $space));

2218

2219

if ($self->get_status() eq "successful") {

2220

if (defined($self->get_conf('KEY_ID')) && $self->get_conf('KEY_ID')) {

2221

my $key_id = $self->get_conf('KEY_ID');

2222

$self->log(sprintf("Signature with key '%s' requested:\n", $key_id));

2223

my $changes = $self->get('Package_SVersion') . '_' . $self->get('Arch') . '.changes';

2224

system (sprintf('debsign -k%s %s', $key_id, $changes));

2225

}

2226

}

2227

2228

my $subject = "Log for " . $self->get_status() .

2229

" build of " . $self->get('Package_Version');

2230

if ($self->get('Arch')) {

2231

$subject .= " on " . $self->get('Arch');

2232

}

2233

if ($self->get_conf('ARCHIVE')) {

2234

$subject .= " (" . $self->get_conf('ARCHIVE') . "/" . $self->get_conf('DISTRIBUTION') . ")";

2235

}

2236

else {

2237

$subject .= " (dist=" . $self->get_conf('DISTRIBUTION') . ")";

2238

}

2239

2240

open(STDERR, '>&', $saved_stderr) or warn "Can't redirect stderr\n"

2241

if defined($saved_stderr);

2242

open(STDOUT, '>&', $saved_stdout) or warn "Can't redirect stdout\n"

2243

if defined($saved_stdout);

2244

$saved_stderr->close();

2245

undef $saved_stderr;

2246

$saved_stdout->close();

2247

undef $saved_stdout;

2248

$self->set('Log File', undef);

2249

if (defined($self->get('Log Stream'))) {

2250

$self->get('Log Stream')->close(); # Close child logger process

2251

$self->set('Log Stream', undef);

2252

}

2253

2254

$self->send_build_log($self->get_conf('MAILTO'), $subject, $filename)

2255

if (defined($filename) && -f $filename &&

2256

$self->get_conf('MAILTO'));

2257

}

2258

2259

sub send_build_log {

2260

my $self = shift;

2261

my $to = shift;

2262

my $subject = shift;

2263

my $filename = shift;

2264

2265

my $conf = $self->get('Config');

2266

2267

if ($conf->get('MIME_BUILD_LOG_MAILS')) {

2268

return $self->send_mime_build_log($to, $subject, $filename);

2269

} else {

2270

return send_mail($conf, $to, $subject, $filename);

2271

}

2272

}

2273

2274

sub send_mime_build_log {

2275

my $self = shift;

2276

my $to = shift;

2277

my $subject = shift;

2278

my $filename = shift;

2279

2280

my $conf = $self->get('Config');

2281

my $tmp; # Needed for gzip, here for proper scoping.

2282

2283

my $msg = MIME::Lite->new(

2284

From => $conf->get('MAILFROM'),

2285

To => $to,

2286

Subject => $subject,

2287

Type => 'multipart/mixed'

2288

);

2289

2290

# Add the GPG key ID to the mail if present so that it's clear if the log

2291

# still needs signing or not.

2292

if (defined($self->get_conf('KEY_ID')) && $self->get_conf('KEY_ID')) {

2293

$msg->add('Key-ID', $self->get_conf('KEY_ID'));

2294

}

2295

2296

if (!$conf->get('COMPRESS_BUILD_LOG_MAILS')) {

2297

my $log_part = MIME::Lite->new(

2298

Type => 'text/plain',

2299

Path => $filename,

2300

Filename => basename($filename)

2301

);

2302

$log_part->attr('content-type.charset' => 'UTF-8');

2303

$msg->attach($log_part);

2304

} else {

2305

local( *F, *GZFILE );

2306

2307

if (!open( F, "<$filename" )) {

2308

warn "Cannot open $filename for mailing: $!\n";

2309

return 0;

2310

}

2311

2312

$tmp = File::Temp->new();

2313

tie *GZFILE, 'IO::Zlib', $tmp->filename, 'wb';

2314

2315

while( <F> ) {

2316

print GZFILE $_;

2317

}

2318

untie *GZFILE;

2319

2320

close F;

2321

close GZFILE;

2322

2323

$msg->attach(

2324

Type => 'application/x-gzip',

2325

Path => $tmp->filename,

2326

Filename => basename($filename) . '.gz'

2327

);

2328

}

2329

2330

my $changes = $self->get('Package_SVersion') . '_' . $self->get('Arch') . '.changes';

2331

if ($self->get_status() eq 'successful' && -r $changes) {

2332

my $log_part = MIME::Lite->new(

2333

Type => 'text/plain',

2334

Path => $changes,

2335

Filename => basename($changes)

2336

);

2337

$log_part->attr('content-type.charset' => 'UTF-8');

2338

$msg->attach($log_part);

2339

}

2340

2341

my $stats = '';

2342

foreach my $stat (sort keys %{$self->get('Summary Stats')}) {

2343

$stats .= sprintf("%s: %s\n", $stat, $self->get('Summary Stats')->{$stat});

2344

}

2345

$msg->attach(

2346

Type => 'text/plain',

2347

Filename => basename($filename) . '.summary',

2348

Data => $stats

2349

);

2350

2351

local $SIG{'PIPE'} = 'IGNORE';

2352

2353

if (!open( MAIL, "|" . $conf->get('MAILPROG') . " -oem $to" )) {

2354

warn "Could not open pipe to " . $conf->get('MAILPROG') . ": $!\n";

2355

close( F );

2356

return 0;

2357

}

2358

2359

$msg->print(\*MAIL);

2360

2361

if (!close( MAIL )) {

2362

warn $conf->get('MAILPROG') . " failed (exit status $?)\n";

2363

return 0;

2364

}

2365

return 1;

2366

}

2367

2368

sub log_symlink {

2369

my $self = shift;

2370

my $log = shift;

2371

my $dest = shift;

2372

2373

unlink $dest; # Don't return on failure, since the symlink will fail.

2374

symlink $log, $dest;

2375

}

2376

2377

sub add_time_entry {

2378

my $self = shift;

2379

my $pkg = shift;

2380

my $t = shift;

2381

2382

return if !$self->get_conf('AVG_TIME_DB');

2383

my %db;

2384

if (!tie %db, 'GDBM_File', $self->get_conf('AVG_TIME_DB'), GDBM_WRCREAT, 0664) {

2385

$self->log_warning("Can't open average time db " . $self->get_conf('AVG_TIME_DB') . "\n");

2386

return;

2387

}

2388

$pkg =~ s/_.*//;

2389

2390

if (exists $db{$pkg}) {

2391

my @times = split( /\s+/, $db{$pkg} );

2392

push( @times, $t );

2393

my $sum = 0;

2394

foreach (@times[1..$#times]) { $sum += $_; }

2395

$times[0] = $sum / (@times-1);

2396

$db{$pkg} = join( ' ', @times );

2397

}

2398

else {

2399

$db{$pkg} = "$t $t";

2400

}

2401

untie %db;

2402

}

2403

2404

sub add_space_entry {

2405

my $self = shift;

2406

my $pkg = shift;

2407

my $space = shift;

2408

2409

my $keepvals = 4;

2410

2411

return if !$self->get_conf('AVG_SPACE_DB') || $space == 0;

2412

my %db;

2413

if (!tie %db, 'GDBM_File', $self->get_conf('AVG_SPACE_DB'), &GDBM_WRCREAT, 0664) {

2414

$self->log_warning("Can't open average space db " . $self->get_conf('AVG_SPACE_DB') . "\n");

2415

return;

2416

}

2417

$pkg =~ s/_.*//;

2418

2419

if (exists $db{$pkg}) {

2420

my @values = split( /\s+/, $db{$pkg} );

2421

shift @values;

2422

unshift( @values, $space );

2423

pop @values if @values > $keepvals;

2424

my ($sum, $n, $weight, $i) = (0, 0, scalar(@values));

2425

for( $i = 0; $i < @values; ++$i) {

2426

$sum += $values[$i] * $weight;

2427

$n += $weight;

2428

}

2429

unshift( @values, $sum/$n );

2430

$db{$pkg} = join( ' ', @values );

2431

}

2432

else {

2433

$db{$pkg} = "$space $space";

2434

}

2435

untie %db;

2436

}

2437

2438

1;