2 # debbugs-loadsql is part of debbugs, and is released
3 # under the terms of the GPL version 2, or any later version, at your
4 # option. See the file README and COPYING for more information.
5 # Copyright 2012 by Don Armstrong <don@donarmstrong.com>.
11 use Getopt::Long qw(:config no_ignore_case);
16 debbugs-loadsql -- load debbugs sql database
20 debbugs-loadsql [options] [subcommand]
23 bugs help versions configuration
24 suites logs packages debinfo
26 --quick, -q only load changed things
27 --progress Show progress bar
28 --service, -s service name
29 --sysconfdir, -c postgresql service config dir
30 --spool-dir debbugs spool directory
31 --debug, -d debugging level (Default 0)
32 --help, -h display this help
33 --man, -m display manual
43 Add bugs (subject, number, etc) to the database
45 --preload create all bugs first, then add information
49 Add version descendant information (which version is based on which version) to
54 Add source maintainers to the BTS
58 Add debbugs configuration information (tags, severity, etc)
62 Add suite information from ftp distribution
64 --ftpdists location of FTP mirror
72 Add package information from the ftp archive
74 --ftpdists location of FTP mirror
75 --suites Suite to operate on
79 Add package information from a debinfo file
81 --null -0 names of debinfo files are null separated
89 Only load changed bugs
93 Show progress bar (requires Term::ProgressBar)
97 Postgreql service to use; defaults to debbugs
99 =item B<--sysconfdir,-c>
101 System configuration directory to use; if not set, defaults to the
102 postgresql default. [Operates by setting PGSYSCONFDIR]
106 Debbugs spool directory; defaults to the value configured in the
107 debbugs configuration file.
111 Output more information about what is happening. Probably not useful
112 if you also set --progress.
120 Display brief useage information.
134 use Debbugs::Common (qw(checkpid lockpid get_hashname getparsedaddrs),
135 qw(getbugcomponent make_list getsourcemaintainers),
137 qw(hash_slice open_compressed_file),);
138 use Debbugs::Config qw(:config);
139 use Debbugs::Status qw(read_bug split_status_fields);
142 use Debbugs::DB::Load qw(:load_bug :load_package :load_suite);
150 use IO::Uncompress::AnyUncompress;
151 use Encode qw(decode_utf8);
152 use List::AllUtils qw(natatime);
161 service => $config{debbugs_db},
165 Getopt::Long::Configure('pass_through');
166 GetOptions(\%options,
172 'spool_dir|spool-dir=s',
175 'debug|d+','help|h|?','man|m');
176 Getopt::Long::Configure('default');
178 pod2usage() if $options{help};
179 pod2usage({verbose=>2}) if $options{man};
181 $DEBUG = $options{debug};
184 ('bugs' => {function => \&add_bugs,
185 arguments => {'preload' => 0,
189 'versions' => {function => \&add_versions,
191 'debinfo' => {function => \&add_debinfo,
192 arguments => {'0|null' => 0,
193 'debinfo_dir|debinfo-dir=s' => 0,
196 'maintainers' => {function => \&add_maintainers,
198 'configuration' => {function => \&add_configuration,
200 'suites' => {function => \&add_suite,
201 arguments => {'ftpdists=s' => 1,
204 'logs' => {function => \&add_logs,
206 'bugs_and_logs' => {function => \&add_bugs_and_logs,
208 'packages' => {function => \&add_packages,
209 arguments => {'ftpdists=s' => 1,
213 'help' => {function => sub {pod2usage({verbose => 2});}}
217 $options{verbose} = $options{verbose} - $options{quiet};
219 if ($options{progress}) {
220 eval "use Term::ProgressBar";
221 push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
225 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
227 if (exists $options{sysconfdir}) {
228 if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
229 delete $ENV{PGSYSCONFDIR};
231 $ENV{PGSYSCONFDIR} = $options{sysconfdir};
235 if (exists $options{spool_dir} and defined $options{spool_dir}) {
236 $config{spool_dir} = $options{spool_dir};
240 if ($options{progress}) {
241 $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
242 warn "Unable to initialize progress bar: $@" if not $prog_bar;
246 my ($subcommand) = shift @ARGV;
247 if (not defined $subcommand) {
248 $subcommand = 'help';
249 print STDERR "You must provide a subcommand; displaying usage.\n";
251 } elsif (not exists $subcommands{$subcommand}) {
252 print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
256 binmode(STDOUT,':encoding(UTF-8)');
257 binmode(STDERR,':encoding(UTF-8)');
260 handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
261 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
264 my ($options,$opts,$p,$config,$argv) = @_;
265 chdir($config->{spool_dir}) or
266 die "chdir $config->{spool_dir} failed: $!";
268 my $verbose = $options->{debug};
273 } elsif (not defined $opts->{bugs}) {
276 $opts->{bugs} //= [];
278 my $s = db_connect($options);
285 if ($opts->{preload}) {
287 walk_bugs(dirs => [@dirs],
288 bugs => $opts->{bugs},
292 bugs_per_call => 10000
294 $s->resultset('Bug')->quick_insert_bugs(@bugs);
296 walk_bugs(dirs => [@dirs],
297 bugs => $opts->{bugs},
299 $verbose?(logging=>\*STDERR):(),
304 if ($options{quick}) {
306 bugs_to_update($s,@bugs);
308 @bugs_to_update = @bugs;
312 for my $bug (@bugs_to_update) {
316 severities => \%severities,
322 die "failure while trying to load bug: $@";
327 handle_load_bug_queue(db => $s,
332 my ($options,$opts,$p,$config,$argv) = @_;
334 my $s = db_connect($options);
336 my @files = @{$argv};
337 $p->target(scalar @files) if $p;
338 for my $file (@files) {
339 my $fh = IO::File->new($file,'r') or
340 die "Unable to open $file for reading: $!";
345 next unless length $_;
346 if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
347 push @versions, [$1,$2];
352 for my $i (reverse 0..($#versions)) {
354 if (not defined $src_pkgs{$versions[$i][0]}) {
355 $src_pkgs{$versions[$i][0]} =
356 $s->resultset('SrcPkg')->
357 get_src_pkg_id($versions[$i][0]);
359 $sp = $src_pkgs{$versions[$i][0]};
360 # There's probably something wrong if the source package
361 # doesn't exist, but we'll skip it for now
362 last if not defined $sp;
363 my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp,
364 ver => $versions[$i][1],
366 last if not defined $sv;
367 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
368 $sv->update({based_on => $ancestor_sv})
370 $ancestor_sv = $sv->id();
378 my ($options,$opts,$p,$config,$argv) = @_;
380 my @files = @{$argv};
381 if (exists $opts->{debinfo_dir} and not @files) {
383 if (-f $_ and /\.debinfo$/) {
384 push @files, $File::Find::name;
393 local $/ = "\0" if $opts->{0};
395 s/\n$// unless $opts->{0};
396 s/\0$// if $opts->{0};
401 return unless @files;
402 my $s = db_connect($options);
403 $p->target(scalar @files) if $p;
404 my $it = natatime 100, @files;
405 while (my @v = $it->()) {
408 FILE: for my $file (@v) {
409 my $fh = IO::File->new($file,'r') or
410 die "Unable to open $file for reading: $!";
411 my $f_stat = stat($file);
412 my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime);
416 next unless length $_;
417 my ($binname, $binver, $binarch, $srcname, $srcver) = split;
418 # if $srcver is not defined, this is probably a broken
419 # .debinfo file [they were causing #686106, see commit
420 # 49c85ab8 in dak.] Basically, $binarch didn't get put into
421 # the file, so we'll fudge it from the filename.
422 if (not defined $srcver) {
423 ($srcname,$srcver) = ($binarch,$srcname);
424 ($binarch) = $file =~ /_([a-z0-9-]+)\.debinfo/;
426 # It turns out that there are debinfo files which are horribly
427 # screwed up, and have junk in them. We need to discard them
429 if (not defined $srcname or
430 not defined $srcver or
431 not defined $binname or
432 not defined $binver or
433 $srcname !~ /^$config{package_name_re}$/o or
434 $binname !~ /^$config{package_name_re}$/o or
435 $srcver !~ /^$config{package_version_re}$/o or
436 $binver !~ /^$config{package_version_re}$/o
438 print STDERR "malformed debinfo: $file\n";
442 [$binname,$binver,$binarch,$srcname,$srcver,$ct_date];
449 for my $di (@debinfos) {
450 Debbugs::DB::Load::load_debinfo($s,@{$di}[0..5],\%cache);
453 $p->update($p->last_update()+@v) if $p;
458 sub add_maintainers {
459 my ($options,$opts,$p,$config,$argv) = @_;
461 my $s = db_connect($options);
462 my $maintainers = getsourcemaintainers() // {};
464 ## get all of the maintainers, and add the missing ones
465 my $maints = $s->resultset('Maintainer')->
466 get_maintainers(values %{$maintainers});
468 my @svs = $s->resultset('SrcVer')->
469 search({maintainer => undef
472 group_by => 'me.src_pkg, src_pkg.pkg',
473 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
474 columns => [qw(me.src_pkg src_pkg.pkg)],
477 $p->target(2+@svs) if $p;
480 if (exists $maintainers->{$sv->{src_pkg}{pkg}}) {
481 my $pkg = $sv->{src_pkg}{pkg};
482 my $maint = $maints->
483 {$maintainers->{$pkg}};
484 $s->txn_do(sub {$s->resultset('SrcVer')->
485 search({maintainer => undef,
486 'src_pkg.pkg' => $pkg
489 )->update({maintainer => $maint})
497 sub add_configuration {
498 my ($options,$opts,$p,$config,$argv) = @_;
500 my $s = db_connect($options);
505 for my $tag (@{$config{tags}}) {
507 $s->resultset('Tag')->find_or_create({tag => $tag});
510 for my $tag ($s->resultset('Tag')->search_rs()->all()) {
511 next if exists $tags{$tag->tag};
519 for my $sev_name (($config{default_severity},@{$config{severity_list}})) {
520 # add all severitites
521 my $sev = $s->resultset('Severity')->find_or_create({severity => $sev_name});
522 # mark strong severities
523 if (grep {$_ eq $sev_name} @{$config{strong_severities}}) {
526 $sev->ordering($order);
529 $sev_names{$sev_name} = 1;
531 # mark obsolete severities
532 for my $sev ($s->resultset('Severity')->search_rs()->all()) {
533 next if exists $sev_names{$sev->severity()};
540 my ($options,$opts,$p,$config,$argv) = @_;
543 my $s = db_connect($options);
544 my $dist_dir = IO::Dir->new($opts->{ftpdists});
546 grep { $_ !~ /^\./ and
547 -d $opts->{ftpdists}.'/'.$_ and
548 not -l $opts->{ftpdists}.'/'.$_
550 while (my $dist = shift @dist_names) {
551 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
552 my ($dist_info,$package_files) =
553 read_release_file($dist_dir.'/Release');
554 load_suite($s,$dist_info);
559 my ($options,$opts,$p,$config,$argv) = @_;
561 chdir($config->{spool_dir}) or
562 die "chdir $config->{spool_dir} failed: $!";
564 my $verbose = $options->{debug};
566 my $initialdir = "db-h";
568 if (defined $argv->[0] and $argv->[0] eq "archive") {
569 $initialdir = "archive";
571 my $s = db_connect($options);
573 walk_bugs(dirs => [(@{$argv}?@{$argv} : $initialdir)],
576 $verbose?(logging => \*STDERR):(),
580 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
581 if (not defined $stat) {
582 print STDERR "Unable to stat $bug $!\n";
585 if ($options{quick}) {
586 my $rs = $s->resultset('Bug')->
587 search({id=>$bug})->single();
588 return if defined $rs and
589 $stat->mtime <= $rs->last_modified()->epoch();
592 load_bug_log(db => $s,
596 die "failure while trying to load bug log $bug\n$@";
601 sub add_bugs_and_logs {
602 my ($options,$opts,$p,$config,$argv) = @_;
604 chdir($config->{spool_dir}) or
605 die "chdir $config->{spool_dir} failed: $!";
607 my $verbose = $options->{debug};
609 my $initialdir = "db-h";
611 if (defined $argv->[0] and $argv->[0] eq "archive") {
612 $initialdir = "archive";
614 my $s = db_connect($options);
620 walk_bugs(dirs => [(@{$argv}?@{$argv} : $initialdir)],
622 $verbose?(logging => \*STDERR):(),
627 if ($options{quick}) {
629 bugs_to_update($s,@bugs);
631 @bugs_to_update = @bugs;
635 for my $bug (@bugs_to_update) {
639 severities => \%severities,
645 die "failure while trying to load bug: $@";
647 for my $bug (@bugs) {
648 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
649 if (not defined $stat) {
650 print STDERR "Unable to stat $bug $!\n";
653 if ($options{quick}) {
654 my $rs = $s->resultset('Bug')->
655 search({id=>$bug})->single();
656 return if defined $rs and
657 $stat->mtime <= $rs->last_modified()->epoch();
660 load_bug_log(db => $s,
664 die "failure while trying to load bug log $bug\n$@";
670 handle_load_bug_queue(db=>$s,
677 my ($options,$opts,$p,$config,$argv) = @_;
679 my $dist_dir = IO::Dir->new($opts->{ftpdists});
681 grep { $_ !~ /^\./ and
682 -d $opts->{ftpdists}.'/'.$_ and
683 not -l $opts->{ftpdists}.'/'.$_
686 while (my $dist = shift @dist_names) {
687 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
688 my ($dist_info,$package_files) =
689 read_release_file($dist_dir.'/Release');
690 $s_p{$dist_info->{Codename}} = $package_files;
693 for my $suite (keys %s_p) {
694 for my $component (keys %{$s_p{$suite}}) {
695 $tot += scalar keys %{$s_p{$suite}{$component}};
698 $p->target($tot) if $p;
701 my $tot_suites = scalar keys %s_p;
703 my $completed_pkgs=0;
704 # parse packages files
705 for my $suite (keys %s_p) {
707 for my $component (keys %{$s_p{$suite}}) {
708 my @archs = keys %{$s_p{$suite}{$component}};
709 if (grep {$_ eq 'source'} @archs) {
710 @archs = ('source',grep {$_ ne 'source'} @archs);
712 for my $arch (@archs) {
713 my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or
714 die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
716 local $/ = ''; # paragraph mode
719 for my $field (qw(Package Maintainer Version Source)) {
720 /^\Q$field\E: (.*)/m;
723 next unless defined $pkg{Package} and
724 defined $pkg{Version};
725 push @pkgs,[$arch,$component,\%pkg];
729 my $s = db_connect($options);
733 $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
734 $completed_pkgs+@pkgs) if $p;
739 $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
740 $completed_pkgs += @pkgs;
746 sub handle_subcommand_arguments {
747 my ($argv,$args) = @_;
749 Getopt::Long::GetOptionsFromArray($argv,
754 for my $arg (keys %{$args}) {
755 next unless $args->{$arg};
756 my $r_arg = $arg; # real argument name
757 $r_arg =~ s/[=\|].+//g;
758 if (not defined $subopt->{$r_arg}) {
759 push @usage_errors, "You must give a $r_arg option";
762 pod2usage(join("\n",@usage_errors)) if @usage_errors;
767 my ($subcommand,$config,$options) = @_;
768 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
769 if ($options->{quick}) {
770 # If this is a quick run, just exit
771 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
774 print STDERR "Another debbugs-loadsql is running; stopping\n";
781 # connect to the database; figure out how to handle errors
783 my $s = Debbugs::DB->connect($options->{dsn} //
784 $options->{service}) or
785 die "Unable to connect to database: ";
788 sub read_release_file {
791 my $rfh = open_compressed_file($file) or
792 die "Unable to open $file for reading: $!";
798 if (s/^(\S+):\s*//) {
799 if ($1 eq 'SHA1'or $1 eq 'SHA256') {
806 my ($sha,$size,$f) = split /\s+/,$_;
807 next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
808 next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
809 my ($component,$arch,$package_source) = ($1,$2,$3);
810 $arch =~ s/binary-//;
811 next if exists $p_f{$component}{$arch};
812 $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
815 return (\%dist_info,\%p_f);
822 for my $bug (@bugs) {
823 my $stat = stat(getbugcomponent($bug,'summary',getbuglocation($bug,'summary')));
824 if (not defined $stat) {
825 print STDERR "Unable to stat $bug $!\n";
828 my $rs = $s->resultset('Bug')->search({id=>$bug})->single();
829 next if defined $rs and $stat->mtime <= $rs->last_modified()->epoch();
830 push @bugs_to_update, $bug;