~ubuntu-branches/ubuntu/precise/devscripts/precise : revision 90

574

"bts-server=s" => \$btsserver,

575

"mutt" => \$opt_mutt,

576

)

577

or die "Usage: bts [options]\nRun $progname --help for more details\n";

577

or die "Usage: $progname [options]\nRun $progname --help for more details\n";

578

579

if ($opt_noconf) {

580

die "bts: --no-conf is only acceptable as the first command-line option!\n";

580

die "$progname: --no-conf is only acceptable as the first command-line option!\n";

581

}

582

if ($opt_help) { bts_help(); exit 0; }

583

if ($opt_version) { bts_version(); exit 0; }

595

if ($opt_mailreader =~ /\%s/) {

596

$mailreader=$opt_mailreader;

597

} else {

598

warn "bts: ignoring invalid --mailreader option: invalid mail command following it.\n";

598

warn "$progname: ignoring invalid --mailreader option: invalid mail command following it.\n";

599

}

600

}

601

604

}

605

606

if ($opt_sendmail and $opt_smtphost) {

607

die "bts: --sendmail and --smtp-host mutually exclusive\n";

607

die "$progname: --sendmail and --smtp-host mutually exclusive\n";

608

} elsif ($opt_mutt and $opt_sendmail) {

609

die "bts: --sendmail and --mutt mutually exclusive\n";

609

die "$progname: --sendmail and --mutt mutually exclusive\n";

610

} elsif ($opt_mutt and $opt_smtphost) {

611

die "bts: --smtp-host and --mutt mutually exclusive\n";

611

die "$progname: --smtp-host and --mutt mutually exclusive\n";

612

}

613

614

$smtphost = $opt_smtphost if $opt_smtphost;

651

if ($opt_cachemode =~ /^(min|mbox|full)$/) {

652

$cachemode=$opt_cachemode;

653

} else {

654

warn "bts: ignoring invalid --cache-mode; must be one of min, mbox, full.\n";

654

warn "$progname: ignoring invalid --cache-mode; must be one of min, mbox, full.\n";

655

}

656

}

657

729

} else {

730

my @matches=grep /^bts_\Q$command[$index]\E/, keys %::;

731

if (@matches != 1) {

732

die "bts: Couldn't find a unique match for the command $command[$index]!\nRun $progname --help for a list of valid commands.\n";

732

die "$progname: Couldn't find a unique match for the command $command[$index]!\nRun $progname --help for a list of valid commands.\n";

733

}

734

735

# Replace the abbreviated command with its expanded equivalent

901

"m|mbox" => \$sub_mboxmode,

902

"mailreader|mail-reader=s" => \$sub_mailreader,

903

)

904

or die "bts: unknown options for bugs command\n";

904

or die "$progname: unknown options for bugs command\n";

905

@_ = @ARGV; # whatever's left

906

907

if (defined $sub_offlinemode) {

917

if ($sub_mailreader =~ /\%s/) {

918

($mailreader, $sub_mailreader) = ($sub_mailreader, $mailreader);

919

} else {

920

warn "bts: ignoring invalid --mailreader $sub_mailreader option:\ninvalid mail command following it.\n";

920

warn "$progname: ignoring invalid --mailreader $sub_mailreader option:\ninvalid mail command following it.\n";

921

$sub_mailreader = undef;

922

}

923

}

1180

sub bts_close {

1181

my ($bug) = common_close(@_);

1182

warn <<"EOT";

1183

bts: Closing $bug as you requested.

1184

Please note that the "bts close" command is deprecated!

1183

$progname: Closing $bug as you requested.

1184

Please note that the "$progname close" command is deprecated!

1185

It is usually better to email nnnnnn-done\@$btsserver with

1186

an informative mail.

1187

Please remember to email $bug-submitter\@$btsserver with

1340

my $bug=checkbug(shift) or die "bts found: found what bug?\n";

1341

my $version=shift;

1342

if (! defined $version) {

1343

warn "bts: found has no version number, but sending to the BTS anyway\n";

1343

warn "$progname: found has no version number, but sending to the BTS anyway\n";

1344

$version="";

1345

}

1346

opts_done(@_);

2008

my @bugs;

2009

2010

if (! have_lwp()) {

2011

die "bts: Couldn't run bts reportspam: $lwp_broken\n";

2011

die "$progname: Couldn't run bts reportspam: $lwp_broken\n";

2012

}

2013

2014

foreach (@_) {

2028

my $request = HTTP::Request->new('GET', $url);

2029

my $response = $ua->request($request);

2030

if (! $response->is_success) {

2031

warn "bts: failed to report $bug as containing spam: " .

2031

warn "$progname: failed to report $bug as containing spam: " .

2032

$response->status_line . "\n";

2033

}

2034

}

2106

"q|quiet+" => \$sub_quiet,

2107

"include-resolved!" => \$sub_includeresolved,

2108

)

2109

or die "bts: unknown options for cache command\n";

2109

or die "$progname: unknown options for cache command\n";

2110

@_ = @ARGV; # whatever's left

2111

2112

if (defined $sub_refreshmode) {

2119

if ($sub_cachemode =~ /^(min|mbox|full)$/) {

2120

($cachemode, $sub_cachemode) = ($sub_cachemode, $cachemode);

2121

} else {

2122

warn "bts: ignoring invalid --cache-mode $sub_cachemode;\nmust be one of min, mbox, full.\n";

2122

warn "$progname: ignoring invalid --cache-mode $sub_cachemode;\nmust be one of min, mbox, full.\n";

2123

}

2124

}

2125

# This may be a no-op, we don't mind

2128

2129

prunecache();

2130

if (! have_lwp()) {

2131

die "bts: Couldn't run bts cache: $lwp_broken\n";

2131

die "$progname: Couldn't run bts cache: $lwp_broken\n";

2132

}

2133

2134

if (! -d $cachedir) {

2135

if (! -d dirname($cachedir)) {

2136

mkdir(dirname($cachedir))

2137

or die "bts: couldn't mkdir ".dirname($cachedir).": $!\n";

2137

or die "$progname: couldn't mkdir ".dirname($cachedir).": $!\n";

2138

}

2139

mkdir($cachedir)

2140

or die "bts: couldn't mkdir $cachedir: $!\n";

2140

or die "$progname: couldn't mkdir $cachedir: $!\n";

2141

}

2142

2143

download("css/bugs.css");

2176

if (keys %oldbugs) {

2177

tie (%timestamp, "Devscripts::DB_File_Lock", $timestampdb,

2178

O_RDWR()|O_CREAT(), 0600, $DB_HASH, "write")

2179

or die "bts: couldn't open DB file $timestampdb for writing: $!\n"

2179

or die "$progname: couldn't open DB file $timestampdb for writing: $!\n"

2180

if ! tied %timestamp;

2181

}

2182

2249

# clean index

2250

tie (%timestamp, "Devscripts::DB_File_Lock", $timestampdb,

2251

O_RDWR()|O_CREAT(), 0600, $DB_HASH, "write")

2252

or die "bts: couldn't open DB file $timestampdb for writing: $!\n"

2252

or die "$progname: couldn't open DB file $timestampdb for writing: $!\n"

2253

if ! tied %timestamp;

2254

2255

if ($toclean =~ /^\d+$/) {

2388

2389

if ($bug eq 'it') {

2390

if (not defined $it) {

2391

die "bts: You specified 'it', but no previous bug number referenced!\n";

2391

die "$progname: You specified 'it', but no previous bug number referenced!\n";

2392

}

2393

} else {

2394

$bug=~s/^(?:(?:bug)?\#)?(-?\d+):?$/$1/i;

2469

DIR => File::Spec->tmpdir,

2470

UNLINK => 1);

2471

open (MAILOUT, ">&", $fh)

2472

or die "bts: writing to temporary file: $!\n";

2472

or die "$progname: writing to temporary file: $!\n";

2473

2474

print MAILOUT $message;

2475

2476

my $mailcmd = $muttcmd;

2477

$mailcmd =~ s/\%([%s])/$1 eq '%' ? '%' : $filename/eg;

2478

2479

exec($mailcmd) or die "bts: unable to start mailclient: $!";

2479

exec($mailcmd) or die "$progname: unable to start mailclient: $!";

2480

}

2481

elsif (length $smtphost) {

2482

my $smtp;

2487

2488

if (have_smtp_ssl) {

2489

$smtp = Net::SMTP::SSL->new($host, Port => $port,

2490

Hello => $smtphelo) or die "bts: failed to open SMTPS connection to $smtphost\n($@)\n";

2490

Hello => $smtphelo) or die "$progname: failed to open SMTPS connection to $smtphost\n($@)\n";

2491

} else {

2492

die "bts: Unable to establish SMTPS connection: $smtp_ssl_broken\n($@)\n";

2492

die "$progname: Unable to establish SMTPS connection: $smtp_ssl_broken\n($@)\n";

2493

}

2494

} else {

2495

my ($host, $port) = split(/:/, $smtphost);

2496

$port ||= '25';

2497

2498

$smtp = Net::SMTP->new($host, Port => $port, Hello => $smtphelo)

2499

or die "bts: failed to open SMTP connection to $smtphost\n($@)\n";

2499

or die "$progname: failed to open SMTP connection to $smtphost\n($@)\n";

2500

}

2501

if ($smtpuser) {

2502

$smtppass = getpass() if not $smtppass;

2503

$smtp->auth($smtpuser, $smtppass)

2504

or die "bts: failed to authenticate to $smtphost\n($@)\n";

2504

or die "$progname: failed to authenticate to $smtphost\n($@)\n";

2505

}

2506

$smtp->mail($fromaddress)

2507

or die "bts: failed to set SMTP from address $fromaddress\n($@)\n";

2507

or die "$progname: failed to set SMTP from address $fromaddress\n($@)\n";

2508

my @addresses = extract_addresses($to);

2509

push @addresses, extract_addresses($cc);

2510

foreach my $address (@addresses) {

2511

$smtp->recipient($address)

2512

or die "bts: failed to set SMTP recipient $address\n($@)\n";

2512

or die "$progname: failed to set SMTP recipient $address\n($@)\n";

2513

}

2514

$smtp->data($message)

2515

or die "bts: failed to send message as SMTP DATA\n($@)\n";

2515

or die "$progname: failed to send message as SMTP DATA\n($@)\n";

2516

$smtp->quit

2517

or die "bts: failed to quit SMTP connection\n($@)\n";

2517

or die "$progname: failed to quit SMTP connection\n($@)\n";

2518

}

2519

else {

2520

my $pid = open(MAIL, "|-");

2521

if (! defined $pid) {

2522

die "bts: Couldn't fork: $!\n";

2522

die "$progname: Couldn't fork: $!\n";

2523

}

2524

$SIG{'PIPE'} = sub { die "bts: pipe for $sendmailcmd broke\n"; };

2524

$SIG{'PIPE'} = sub { die "$progname: pipe for $sendmailcmd broke\n"; };

2525

if ($pid) {

2526

# parent

2527

print MAIL $message;

2528

close MAIL or die "bts: sendmail error: $!\n";

2528

close MAIL or die "$progname: sendmail error: $!\n";

2529

}

2530

else {

2531

# child

2532

if ($debug) {

2533

exec("/bin/cat")

2534

or die "bts: error running cat: $!\n";

2534

or die "$progname: error running cat: $!\n";

2535

} else {

2536

my @mailcmd = split ' ', $sendmailcmd;

2537

push @mailcmd, "-t" if $sendmailcmd =~ /$sendmail_t/;

2538

exec @mailcmd

2539

or die "bts: error running sendmail: $!\n";

2539

or die "$progname: error running sendmail: $!\n";

2540

}

2541

}

2542

}

2626

}

2627

2628

unless (system("command -v mail >/dev/null 2>&1") == 0) {

2629

die "bts: You need to either set DEBEMAIL or have the mailx/mailutils package\ninstalled to send mail!\n";

2629

die "$progname: You need to either set DEBEMAIL or have the mailx/mailutils package\ninstalled to send mail!\n";

2630

}

2631

my $pid = open(MAIL, "|-");

2632

if (! defined $pid) {

2633

die "bts: Couldn't fork: $!\n";

2633

die "$progname: Couldn't fork: $!\n";

2634

}

2635

$SIG{'PIPE'} = sub { die "bts: pipe for mail broke\n"; };

2635

$SIG{'PIPE'} = sub { die "$progname: pipe for mail broke\n"; };

2636

if ($pid) {

2637

# parent

2638

print MAIL $body;

2639

close MAIL or die "bts: mail: $!\n";

2639

close MAIL or die "$progname: mail: $!\n";

2640

}

2641

else {

2642

# child

2643

if ($debug) {

2644

exec("/bin/cat")

2645

or die "bts: error running cat: $!\n";

2645

or die "$progname: error running cat: $!\n";

2646

} else {

2647

$ccemail =~ s/ //g;

2648

my @args;

2650

push(@args, "-c", "$ccemail") if $ccemail;

2651

push(@args, "-a", "X-Debbugs-No-Ack: Yes")

2652

if $requestack==0;

2653

exec("mail", @args) or die "bts: error running mail: $!\n";

2653

exec("mail", @args) or die "$progname: error running mail: $!\n";

2654

}

2655

}

2656

}

2717

2718

sub getpass() {

2719

system "stty -echo cbreak </dev/tty";

2720

die "bts: error disabling stty echo\n" if $?;

2720

die "$progname: error disabling stty echo\n" if $?;

2721

print "\a${smtpuser}";

2722

print "\@$smtphost" if $smtpuser !~ /\@/;

2723

print "'s SMTP password: ";

2725

chomp;

2726

print "\n";

2727

system "stty echo -cbreak </dev/tty";

2728

die "bts: error enabling stty echo\n" if $?;

2728

die "$progname: error enabling stty echo\n" if $?;

2729

return $_;

2730

}

2731

2732

sub extractemail() {

2733

my $thing=shift or die "bts: extract e-mail from what?\n";

2733

my $thing=shift or die "$progname: extract e-mail from what?\n";

2734

2735

if ($thing =~ /^(.*?)\s+<(.*)>\s*$/) {

2736

$thing = $2;

2749

}

2750

else { # No $from

2751

unless (system("command -v mail >/dev/null 2>&1") == 0) {

2752

die "bts: You need to either specify an email address (say using DEBEMAIL)\n or have the mailx/mailutils package installed to send mail!\n";

2752

die "$progname: You need to either specify an email address (say using DEBEMAIL)\n or have the mailx/mailutils package installed to send mail!\n";

2753

}

2754

my $pid = open(MAIL, "|-");

2755

if (! defined $pid) {

2756

die "bts: Couldn't fork: $!\n";

2756

die "$progname: Couldn't fork: $!\n";

2757

}

2758

$SIG{'PIPE'} = sub { die "bts: pipe for mail broke\n"; };

2758

$SIG{'PIPE'} = sub { die "$progname: pipe for mail broke\n"; };

2759

if ($pid) {

2760

# parent

2761

print MAIL $body;

2762

close MAIL or die "bts: mail: $!\n";

2762

close MAIL or die "$progname: mail: $!\n";

2763

}

2764

else {

2765

# child

2766

if ($debug) {

2767

exec("/bin/cat")

2768

or die "bts: error running cat: $!\n";

2768

or die "$progname: error running cat: $!\n";

2769

} else {

2770

exec("mail", "-s", $subject, $to)

2771

or die "bts: error running mail: $!\n";

2771

or die "$progname: error running mail: $!\n";

2772

}

2773

}

2774

}

2910

}

2911

2912

if (! -d $cachedir) {

2913

die "bts: download() called but no cachedir!\n";

2913

die "$progname: download() called but no cachedir!\n";

2914

}

2915

2916

chdir($cachedir) || die "bts: chdir $cachedir: $!\n";

2916

chdir($cachedir) || die "$progname: chdir $cachedir: $!\n";

2917

2918

if (-f cachefile($thing, $thgopts)) {

2919

($timestamp, $versionstamp) = get_timestamp($thing, $thgopts);

2934

if (! -r mboxfile($thing)) {

2935

$forcedownload = 1;

2936

} elsif ($cachemode eq 'full' and -d $thing) {

2937

opendir DIR, $thing or die "bts: opendir $cachedir/$thing: $!\n";

2937

opendir DIR, $thing or die "$progname: opendir $cachedir/$thing: $!\n";

2938

my @htmlfiles = grep { /^\d+\.html$/ } readdir(DIR);

2939

closedir DIR;

2940

$forcedownload = 1 unless @htmlfiles;

2964

print "$bug_current/$bug_total" if $bug_total;

2965

print "\n";

2966

}

2967

chdir $oldcwd or die "bts: chdir $oldcwd failed: $!\n";

2967

chdir $oldcwd or die "$progname: chdir $oldcwd failed: $!\n";

2968

return "";

2969

}

2970

elsif ($ret == MIRROR_DOWNLOADED) {

2972

# we've successfully stashed the data away

2973

$timestamp = time;

2974

2975

die "bts: empty page downloaded\n" unless length $livepage;

2975

die "$progname: empty page downloaded\n" unless length $livepage;

2976

2977

my $bug2filename = { };

2978

2985

2986

my $data = $livepage; # work on a copy, not the original

2987

my $cachefile=cachefile($thing,$thgopts);

2988

open (OUT_CACHE, ">$cachefile") or die "bts: open $cachefile: $!\n";

2988

open (OUT_CACHE, ">$cachefile") or die "$progname: open $cachefile: $!\n";

2989

2990

$data = mangle_cache_file($data, $thing, $bug2filename, $timestamp, $charset ? $contenttype : '');

2991

print OUT_CACHE $data;

2992

close OUT_CACHE or die "bts: problems writing to $cachefile: $!\n";

2992

close OUT_CACHE or die "$progname: problems writing to $cachefile: $!\n";

2993

2994

set_timestamp($thing, $thgopts,

2995

$manual ? make_manual($timestamp) : make_automatic($timestamp),

3011

$base=~s%/[^/]*$%%;

3012

$livepage=~s%<head>%<head><base href="$base">%i;

3013

3014

chdir $oldcwd or die "bts: chdir $oldcwd failed: $!\n";

3014

chdir $oldcwd or die "$progname: chdir $oldcwd failed: $!\n";

3015

return $livepage;

3016

} else {

3017

die "bts: couldn't download $url:\n$msg\n";

3017

die "$progname: couldn't download $url:\n$msg\n";

3018

}

3019

}

3020

3048

# it's an attachment, must download

3049

3050

if (-f dirname($filename)) {

3051

warn "bts: found file where directory expected; using existing file (" . dirname($filename) . ")\n";

3051

warn "$progname: found file where directory expected; using existing file (" . dirname($filename) . ")\n";

3052

$bug2filename{$msg} = dirname($filename);

3053

} else {

3054

$bug2filename{$msg} = $filename;

3098

my $content_length = defined $response->content ?

3099

length($response->content) : 0;

3100

if ($content_length == 0) {

3101

warn "bts: failed to download $ref, skipping\n";

3101

warn "$progname: failed to download $ref, skipping\n";

3102

next;

3103

}

3104

3112

}

3113

mkpath(dirname $bug2filename{$msg});

3114

open OUT_CACHE, ">$bug2filename{$msg}"

3115

or die "bts: open cache $bug2filename{$msg}\n";

3115

or die "$progname: open cache $bug2filename{$msg}\n";

3116

print OUT_CACHE $data;

3117

close OUT_CACHE;

3118

} else {

3119

warn "bts: failed to download $ref, skipping\n";

3119

warn "$progname: failed to download $ref, skipping\n";

3120

next;

3121

}

3122

}

3132

my $temp = shift; # do we wish to store it in cache or in a temp file?

3133

my $mboxfile = mboxfile($thing);

3134

3135

die "bts: trying to download mbox for illegal bug number $thing.\n"

3135

die "$progname: trying to download mbox for illegal bug number $thing.\n"

3136

unless $mboxfile;

3137

3138

if (! have_lwp()) {

3139

die "bts: couldn't run bts --mbox: $lwp_broken\n";

3139

die "$progname: couldn't run bts --mbox: $lwp_broken\n";

3140

}

3141

init_agent() unless $ua;

3142

3146

my $content_length = defined $response->content ?

3147

length($response->content) : 0;

3148

if ($content_length == 0) {

3149

die "bts: failed to download mbox.\n";

3149

die "$progname: failed to download mbox.\n";

3150

}

3151

3152

my ($fh, $filename);

3157

UNLINK => 1);

3158

# Use filehandle for security

3159

open (OUT_MBOX, ">&", $fh)

3160

or die "bts: writing to temporary file: $!\n";

3160

or die "$progname: writing to temporary file: $!\n";

3161

} else {

3162

$filename = $mboxfile;

3163

open (OUT_MBOX, ">$mboxfile")

3164

or die "bts: writing to mbox file $mboxfile: $!\n";

3164

or die "$progname: writing to mbox file $mboxfile: $!\n";

3165

}

3166

print OUT_MBOX $response->content;

3167

close OUT_MBOX;

3168

3169

return ($fh, $filename);

3170

} else {

3171

die "bts: failed to download mbox.\n";

3171

die "$progname: failed to download mbox.\n";

3172

}

3173

}

3174

3271

my $thgopts=shift || '';

3272

3273

if (! -d $cachedir) {

3274

die "bts: deletecache() called but no cachedir!\n";

3274

die "$progname: deletecache() called but no cachedir!\n";

3275

}

3276

3277

delete_timestamp($thing,$thgopts);

3288

sub cachefile {

3289

my $thing=shift;

3290

my $thgopts=shift || '';

3291

if ($thing eq '') { die "bts: cachefile given empty argument\n"; }

3291

if ($thing eq '') { die "$progname: cachefile given empty argument\n"; }

3292

if ($thing =~ /bugs.css$/) { return $cachedir."bugs.css" }

3293

$thing =~ s/^src:/src_/;

3294

$thing =~ s/^from:/from_/;

3310

# Given a bug number, returns the dirname for it in the cache.

3311

sub cachebugdir {

3312

my $thing=shift;

3313

if ($thing !~ /^\d+$/) { die "bts: cachebugdir given faulty argument: $thing\n"; }

3313

if ($thing !~ /^\d+$/) { die "$progname: cachebugdir given faulty argument: $thing\n"; }

3314

return $cachedir.$thing;

3315

}

3316

3374

3375

if (-f $cachefile) {

3376

local $/;

3377

open (IN, $cachefile) || die "bts: open $cachefile: $!\n";

3377

open (IN, $cachefile) || die "$progname: open $cachefile: $!\n";

3378

my $data=<IN>;

3379

close IN;

3380

3454

}

3455

else {

3456

$href =~ s/>.*/>/s;

3457

warn "bts: in href_to_filename: unrecognised BTS URL type: $href\n";

3457

warn "$progname: in href_to_filename: unrecognised BTS URL type: $href\n";

3458

return undef;

3459

}

3460

}

3498

3499

if ($thing eq '') {

3500

if ($thgopts ne '') {

3501

die "bts: you can only give options for a BTS page if you specify a bug/maint/... .\n";

3501

die "$progname: you can only give options for a BTS page if you specify a bug/maint/... .\n";

3502

}

3503

runbrowser($btsurl);

3504

return;

3508

my $cachefile=cachefile($thing,$thgopts);

3509

my $mboxfile=mboxfile($thing);

3510

if ($mboxmode and ! $mboxfile) {

3511

die "bts: you can only request a mailbox for a single bug report.\n";

3511

die "$progname: you can only request a mailbox for a single bug report.\n";

3512

}

3513

3514

# Check that if we're requesting a tag, that it's a valid tag

3515

if (($thing.$thgopts) =~ /(?:^|;)(?:tag|include|exclude)[:=]([^;]*)/) {

3516

unless (exists $valid_tags{$1}) {

3517

die "bts: invalid tag requested: $1\nRecognised tag names are: " . join(" ", @valid_tags) . "\n";

3517

die "$progname: invalid tag requested: $1\nRecognised tag names are: " . join(" ", @valid_tags) . "\n";

3518

}

3519

}

3520

3522

if ($offlinemode) {

3523

$livedownload = 0;

3524

if (! $hascache) {

3525

die "bts: Sorry, you are in offline mode and have no cache.\nRun \"bts cache\" or \"bts show\" to create one.\n";

3525

die "$progname: Sorry, you are in offline mode and have no cache.\nRun \"bts cache\" or \"bts show\" to create one.\n";

3526

}

3527

elsif ((! $mboxmode and ! -r $cachefile) or

3528

($mboxmode and ! -r $mboxfile)) {

3529

die "bts: Sorry, you are in offline mode and that is not cached.\nUse \"bts [--cache-mode=...] cache\" to update the cache.\n";

3529

die "$progname: Sorry, you are in offline mode and that is not cached.\nUse \"bts [--cache-mode=...] cache\" to update the cache.\n";

3530

}

3531

if ($mboxmode) {

3532

runmailreader($mboxfile);

3539

if (! $hascache) {

3540

if (! -d dirname($cachedir)) {

3541

unless (mkdir(dirname($cachedir))) {

3542

warn "bts: couldn't mkdir ".dirname($cachedir).": $!\n";

3542

warn "$progname: couldn't mkdir ".dirname($cachedir).": $!\n";

3543

goto LIVE;

3544

}

3545

}

3546

unless (mkdir($cachedir)) {

3547

warn "bts: couldn't mkdir $cachedir: $!\n";

3547

warn "$progname: couldn't mkdir $cachedir: $!\n";

3548

goto LIVE;

3549

}

3550

}

3563

3564

# Use filehandle for security

3565

open (OUT_LIVE, ">&", $fh)

3566

or die "bts: writing to temporary file: $!\n";

3566

or die "$progname: writing to temporary file: $!\n";

3567

# Correct relative urls to point to the bts.

3568

$live =~ s%\shref="(?:/cgi-bin/)?(\w+\.cgi)% href="$btscgiurl$1%g;

3569

print OUT_LIVE $live;

3606

3607

my $oldcwd = getcwd;

3608

3609

chdir($cachedir) || die "bts: chdir $cachedir: $!\n";

3609

chdir($cachedir) || die "$progname: chdir $cachedir: $!\n";

3610

3611

# remove the now-defunct live-download file

3612

unlink "live_download.html";

3613

3614

opendir DIR, '.' or die "bts: opendir $cachedir: $!\n";

3614

opendir DIR, '.' or die "$progname: opendir $cachedir: $!\n";

3615

my @cachefiles = grep { ! /^\.\.?$/ } readdir(DIR);

3616

closedir DIR;

3617

3636

}

3637

}

3638

3639

warn "bts: unexpected files/dirs in cache directory $cachedir:\n " .

3639

warn "$progname: unexpected files/dirs in cache directory $cachedir:\n " .

3640

join("\n ", keys %weirdfiles) . "\n"

3641

if keys %weirdfiles;

3642

3649

# We now remove the oldfiles if they're automatically downloaded

3650

tie (%timestamp, "Devscripts::DB_File_Lock", $timestampdb,

3651

O_RDWR()|O_CREAT(), 0600, $DB_HASH, "write")

3652

or die "bts: couldn't open DB file $timestampdb for writing: $!\n"

3652

or die "$progname: couldn't open DB file $timestampdb for writing: $!\n"

3653

if ! tied %timestamp;

3654

3655

my @unrecognised;

3668

untie %timestamp;

3669

3670

if (! -e $prunestamp) {

3671

open PRUNESTAMP, ">$prunestamp" || die "bts: prune timestamp: $!\n";

3671

open PRUNESTAMP, ">$prunestamp" || die "$progname: prune timestamp: $!\n";

3672

close PRUNESTAMP;

3673

}

3674

chdir $oldcwd || die "bts: chdir $oldcwd: $!\n";

3674

chdir $oldcwd || die "$progname: chdir $oldcwd: $!\n";

3675

utime time, time, $prunestamp;

3676

}

3677

3688

sub runmailreader {

3689

my $file = shift;

3690

my $quotedfile;

3691

die "bts: could not read mbox file!\n" unless -r $file;

3691

die "$progname: could not read mbox file!\n" unless -r $file;

3692

3693

if ($file !~ /\'/) { $quotedfile = qq['$file']; }

3694

elsif ($file !~ /[\"\\\$\'\!]/) { $quotedfile = qq["$file"]; }

3695

else { die "bts: could not figure out how to quote the mbox filename \"$file\"\n"; }

3695

else { die "$progname: could not figure out how to quote the mbox filename \"$file\"\n"; }

3696

3697

my $reader = $mailreader;

3698

$reader =~ s/\%([%s])/$1 eq '%' ? '%' : $quotedfile/eg;

3719

} else {

3720

tie (%timestamp, "Devscripts::DB_File_Lock", $timestampdb,

3721

O_RDONLY(), 0600, $DB_HASH, "read")

3722

or die "bts: couldn't open DB file $timestampdb for reading: $!\n";

3722

or die "$progname: couldn't open DB file $timestampdb for reading: $!\n";

3723

3724

($timestamp, $versionstamp) = split /;/, $timestamp{$thing.$thgopts}

3725

if exists $timestamp{$thing.$thgopts};

3741

} else {

3742

tie (%timestamp, "Devscripts::DB_File_Lock", $timestampdb,

3743

O_RDWR()|O_CREAT(), 0600, $DB_HASH, "write")

3744

or die "bts: couldn't open DB file $timestampdb for writing: $!\n";

3744

or die "$progname: couldn't open DB file $timestampdb for writing: $!\n";

3745

3746

$timestamp{$thing.$thgopts} = "$timestamp;$versionstamp";

3747

3758

} else {

3759

tie (%timestamp, "Devscripts::DB_File_Lock", $timestampdb,

3760

O_RDWR()|O_CREAT(), 0600, $DB_HASH, "write")

3761

or die "bts: couldn't open DB file $timestampdb for writing: $!\n";

3761

or die "$progname: couldn't open DB file $timestampdb for writing: $!\n";

3762

3763

delete $timestamp{$thing.$thgopts};

3764

3872

3873

sub opts_done {

3874

if (@_) {

3875

die "bts: unknown options to '$command[$index]': @_\n";

3875

die "$progname: unknown options to '$command[$index]': @_\n";

3876

}

3877

}

3878

3883

SUFFIX => ".mail",

3884

DIR => File::Spec->tmpdir);

3885

open(OUT_MAIL, ">$filename")

3886

or die "bts: writing to temporary file: $!\n";

3886

or die "$progname: writing to temporary file: $!\n";

3887

print OUT_MAIL $message;

3888

close OUT_MAIL;

3889

system("sensible-editor $filename");

3890

open(OUT_MAIL, "<$filename")

3891

or die "bts: reading from temporary file: $!\n";

3891

or die "$progname: reading from temporary file: $!\n";

3892

$message = "";

3893

while(<OUT_MAIL>) {

3894

$message .= $_;