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 # if we're running out of git, we want to use the git base directory as the
135 # first INC directory. If you're not running out of git, or someone has given a
136 # non-absolute INC, don't do that.
138 use if (-d $FindBin::Bin.'/../.git/' && $INC[0] =~ m#^/#),
139 lib => $FindBin::Bin.'/../lib';
141 use Debbugs::Common (qw(checkpid lockpid get_hashname getparsedaddrs),
142 qw(getbugcomponent make_list getsourcemaintainers),
145 qw(hash_slice open_compressed_file),);
146 use Debbugs::Config qw(:config);
147 use Debbugs::Status qw(read_bug split_status_fields);
150 use Debbugs::DB::Load qw(:load_bug :load_package :load_suite);
158 use IO::Uncompress::AnyUncompress;
159 use Encode qw(decode_utf8);
160 use List::AllUtils qw(natatime);
169 service => $config{database},
173 Getopt::Long::Configure('pass_through');
174 GetOptions(\%options,
180 'spool_dir|spool-dir=s',
183 'debug|d+','help|h|?','man|m');
184 Getopt::Long::Configure('default');
186 pod2usage() if $options{help};
187 pod2usage({verbose=>2}) if $options{man};
189 $DEBUG = $options{debug};
192 ('bugs' => {function => \&add_bugs,
193 arguments => {'preload' => 0,
197 'versions' => {function => \&add_versions,
199 'debinfo' => {function => \&add_debinfo,
200 arguments => {'0|null' => 0,
201 'debinfo_dir|debinfo-dir=s' => 0,
204 'maintainers' => {function => \&add_maintainers,
206 'configuration' => {function => \&add_configuration,
208 'suites' => {function => \&add_suite,
209 arguments => {'ftpdists=s' => 1,
212 'logs' => {function => \&add_logs,
214 'bugs_and_logs' => {function => \&add_bugs_and_logs,
216 'packages' => {function => \&add_packages,
217 arguments => {'ftpdists=s' => 1,
221 'help' => {function => sub {pod2usage({verbose => 2});}}
225 $options{verbose} = $options{verbose} - $options{quiet};
227 if ($options{progress}) {
228 eval "use Term::ProgressBar";
229 push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
233 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
235 if (exists $options{sysconfdir}) {
236 if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
237 delete $ENV{PGSYSCONFDIR};
239 $ENV{PGSYSCONFDIR} = $options{sysconfdir};
243 if (exists $options{spool_dir} and defined $options{spool_dir}) {
244 $config{spool_dir} = $options{spool_dir};
248 if ($options{progress}) {
249 $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
250 warn "Unable to initialize progress bar: $@" if not $prog_bar;
254 my ($subcommand) = shift @ARGV;
255 if (not defined $subcommand) {
256 $subcommand = 'help';
257 print STDERR "You must provide a subcommand; displaying usage.\n";
259 } elsif (not exists $subcommands{$subcommand}) {
260 print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
264 binmode(STDOUT,':encoding(UTF-8)');
265 binmode(STDERR,':encoding(UTF-8)');
268 handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
269 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
272 my ($options,$opts,$p,$config,$argv) = @_;
273 chdir($config->{spool_dir}) or
274 die "chdir $config->{spool_dir} failed: $!";
276 my $verbose = $options->{debug};
281 } elsif (not defined $opts->{bugs}) {
284 $opts->{bugs} //= [];
286 my $s = db_connect($options);
293 if ($opts->{preload}) {
295 walk_bugs(dirs => [@dirs],
296 bugs => $opts->{bugs},
300 bugs_per_call => 10000
302 $s->resultset('Bug')->quick_insert_bugs(@bugs);
304 walk_bugs(dirs => [@dirs],
305 bugs => $opts->{bugs},
307 $verbose?(logging=>\*STDERR):(),
312 if ($options{quick}) {
314 bugs_to_update($s,@bugs);
316 @bugs_to_update = @bugs;
320 for my $bug (@bugs_to_update) {
324 severities => \%severities,
330 die "failure while trying to load bug: $@";
335 handle_load_bug_queue(db => $s,
340 my ($options,$opts,$p,$config,$argv) = @_;
342 my $s = db_connect($options);
344 my @files = @{$argv};
345 $p->target(scalar @files) if $p;
346 for my $file (@files) {
347 my $fh = IO::File->new($file,'r') or
348 die "Unable to open $file for reading: $!";
353 next unless length $_;
354 if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
355 push @versions, [$1,$2];
360 for my $i (reverse 0..($#versions)) {
362 if (not defined $src_pkgs{$versions[$i][0]}) {
363 $src_pkgs{$versions[$i][0]} =
364 $s->resultset('SrcPkg')->
365 get_or_create_src_pkg_id($versions[$i][0]);
367 $sp = $src_pkgs{$versions[$i][0]};
368 # There's probably something wrong if the source package
369 # doesn't exist, but we'll skip it for now
370 last if not defined $sp;
371 my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp,
372 ver => $versions[$i][1],
374 last if not defined $sv;
375 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
376 $sv->update({based_on => $ancestor_sv})
378 $ancestor_sv = $sv->id();
386 my ($options,$opts,$p,$config,$argv) = @_;
388 my @files = @{$argv};
389 if (exists $opts->{debinfo_dir} and not @files) {
391 if (-f $_ and /\.debinfo$/) {
392 push @files, $File::Find::name;
401 local $/ = "\0" if $opts->{0};
403 s/\n$// unless $opts->{0};
404 s/\0$// if $opts->{0};
409 return unless @files;
410 my $s = db_connect($options);
411 $p->target(scalar @files) if $p;
412 my $it = natatime 100, @files;
413 while (my @v = $it->()) {
416 FILE: for my $file (@v) {
417 my $fh = IO::File->new($file,'r') or
418 die "Unable to open $file for reading: $!";
419 my $f_stat = stat($file);
420 my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime);
424 next unless length $_;
425 my ($binname, $binver, $binarch, $srcname, $srcver) = split;
426 # if $srcver is not defined, this is probably a broken
427 # .debinfo file [they were causing #686106, see commit
428 # 49c85ab8 in dak.] Basically, $binarch didn't get put into
429 # the file, so we'll fudge it from the filename.
430 if (not defined $srcver) {
431 ($srcname,$srcver) = ($binarch,$srcname);
432 ($binarch) = $file =~ /_([a-z0-9-]+)\.debinfo/;
434 # It turns out that there are debinfo files which are horribly
435 # screwed up, and have junk in them. We need to discard them
437 if (not defined $srcname or
438 not defined $srcver or
439 not defined $binname or
440 not defined $binver or
441 not defined $binarch or
442 $srcname !~ /^$config{package_name_re}$/o or
443 $binname !~ /^$config{package_name_re}$/o or
444 $srcver !~ /^$config{package_version_re}$/o or
445 $binver !~ /^$config{package_version_re}$/o
447 print STDERR "malformed debinfo: $file\n$_\n";
451 [$binname,$binver,$binarch,$srcname,$srcver,$ct_date];
458 for my $di (@debinfos) {
459 Debbugs::DB::Load::load_debinfo($s,@{$di}[0..5],\%cache);
462 $p->update($p->last_update()+@v) if $p;
467 sub add_maintainers {
468 my ($options,$opts,$p,$config,$argv) = @_;
470 my $s = db_connect($options);
471 my $maintainers = getsourcemaintainers() // {};
473 ## get all of the maintainers, and add the missing ones
474 my $maints = $s->resultset('Maintainer')->
475 get_maintainers(values %{$maintainers});
477 my @svs = $s->resultset('SrcVer')->
478 search({maintainer => undef
481 group_by => 'me.src_pkg, src_pkg.pkg',
482 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
483 columns => [qw(me.src_pkg src_pkg.pkg)],
486 $p->target(2+@svs) if $p;
489 if (exists $maintainers->{$sv->{src_pkg}{pkg}}) {
490 my $pkg = $sv->{src_pkg}{pkg};
491 my $maint = $maints->
492 {$maintainers->{$pkg}};
493 $s->txn_do(sub {$s->resultset('SrcVer')->
494 search({maintainer => undef,
495 'src_pkg.pkg' => $pkg
498 )->update({maintainer => $maint})
506 sub add_configuration {
507 my ($options,$opts,$p,$config,$argv) = @_;
509 my $s = db_connect($options);
514 for my $tag (@{$config{tags}}) {
516 $s->resultset('Tag')->find_or_create({tag => $tag});
519 for my $tag ($s->resultset('Tag')->search_rs()->all()) {
520 next if exists $tags{$tag->tag};
528 for my $sev_name (($config{default_severity},@{$config{severity_list}})) {
529 # add all severitites
530 my $sev = $s->resultset('Severity')->find_or_create({severity => $sev_name});
531 # mark strong severities
532 if (grep {$_ eq $sev_name} @{$config{strong_severities}}) {
535 $sev->ordering($order);
538 $sev_names{$sev_name} = 1;
540 # mark obsolete severities
541 for my $sev ($s->resultset('Severity')->search_rs()->all()) {
542 next if exists $sev_names{$sev->severity()};
549 my ($options,$opts,$p,$config,$argv) = @_;
552 my $s = db_connect($options);
553 my $dist_dir = IO::Dir->new($opts->{ftpdists});
555 grep { $_ !~ /^\./ and
556 -d $opts->{ftpdists}.'/'.$_ and
557 not -l $opts->{ftpdists}.'/'.$_
559 while (my $dist = shift @dist_names) {
560 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
561 my ($dist_info,$package_files) =
562 read_release_file($dist_dir.'/Release');
563 load_suite($s,$dist_info);
568 my ($options,$opts,$p,$config,$argv) = @_;
570 chdir($config->{spool_dir}) or
571 die "chdir $config->{spool_dir} failed: $!";
573 my $verbose = $options->{debug};
575 my $initialdir = "db-h";
577 if (defined $argv->[0] and $argv->[0] eq "archive") {
578 $initialdir = "archive";
580 my $s = db_connect($options);
582 walk_bugs(dirs => [(@{$argv}?@{$argv} : $initialdir)],
585 $verbose?(logging => \*STDERR):(),
589 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
590 if (not defined $stat) {
591 print STDERR "Unable to stat $bug $!\n";
594 if ($options{quick}) {
595 my $rs = $s->resultset('Bug')->
596 search({id=>$bug})->single();
597 return if defined $rs and
598 $stat->mtime <= $rs->last_modified()->epoch();
601 load_bug_log(db => $s,
605 die "failure while trying to load bug log $bug\n$@";
610 sub add_bugs_and_logs {
611 my ($options,$opts,$p,$config,$argv) = @_;
613 chdir($config->{spool_dir}) or
614 die "chdir $config->{spool_dir} failed: $!";
616 my $verbose = $options->{debug};
618 my $initialdir = "db-h";
620 if (defined $argv->[0] and $argv->[0] eq "archive") {
621 $initialdir = "archive";
623 my $s = db_connect($options);
629 walk_bugs(dirs => [(@{$argv}?@{$argv} : $initialdir)],
631 $verbose?(logging => \*STDERR):(),
636 if ($options{quick}) {
638 bugs_to_update($s,@bugs);
640 @bugs_to_update = @bugs;
644 for my $bug (@bugs_to_update) {
648 severities => \%severities,
654 die "failure while trying to load bug: $@";
656 for my $bug (@bugs) {
657 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
658 if (not defined $stat) {
659 print STDERR "Unable to stat $bug $!\n";
662 if ($options{quick}) {
663 my $rs = $s->resultset('Bug')->
664 search({id=>$bug})->single();
665 return if defined $rs and
666 $stat->mtime <= $rs->last_modified()->epoch();
669 load_bug_log(db => $s,
673 die "failure while trying to load bug log $bug\n$@";
679 handle_load_bug_queue(db=>$s,
686 my ($options,$opts,$p,$config,$argv) = @_;
688 my $dist_dir = IO::Dir->new($opts->{ftpdists});
690 grep { $_ !~ /^\./ and
691 -d $opts->{ftpdists}.'/'.$_ and
692 not -l $opts->{ftpdists}.'/'.$_
695 while (my $dist = shift @dist_names) {
696 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
697 my ($dist_info,$package_files) =
698 read_release_file($dist_dir.'/Release');
699 $s_p{$dist_info->{Codename}} = $package_files;
702 for my $suite (keys %s_p) {
703 for my $component (keys %{$s_p{$suite}}) {
704 $tot += scalar keys %{$s_p{$suite}{$component}};
707 $p->target($tot) if $p;
710 my $tot_suites = scalar keys %s_p;
712 my $completed_pkgs=0;
713 # parse packages files
714 for my $suite (keys %s_p) {
716 for my $component (keys %{$s_p{$suite}}) {
717 my @archs = keys %{$s_p{$suite}{$component}};
718 if (grep {$_ eq 'source'} @archs) {
719 @archs = ('source',grep {$_ ne 'source'} @archs);
721 for my $arch (@archs) {
722 my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or
723 die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
725 local $/ = ''; # paragraph mode
728 for my $field (qw(Package Maintainer Version Source)) {
729 /^\Q$field\E: (.*)/m;
732 next unless defined $pkg{Package} and
733 defined $pkg{Version};
734 push @pkgs,[$arch,$component,\%pkg];
738 my $s = db_connect($options);
742 $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
743 $completed_pkgs+@pkgs) if $p;
748 $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
749 $completed_pkgs += @pkgs;
755 sub handle_subcommand_arguments {
756 my ($argv,$args) = @_;
758 Getopt::Long::GetOptionsFromArray($argv,
763 for my $arg (keys %{$args}) {
764 next unless $args->{$arg};
765 my $r_arg = $arg; # real argument name
766 $r_arg =~ s/[=\|].+//g;
767 if (not defined $subopt->{$r_arg}) {
768 push @usage_errors, "You must give a $r_arg option";
771 pod2usage(join("\n",@usage_errors)) if @usage_errors;
776 my ($subcommand,$config,$options) = @_;
777 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
778 if ($options->{quick}) {
779 # If this is a quick run, just exit
780 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
783 print STDERR "Another debbugs-loadsql is running; stopping\n";
790 # connect to the database; figure out how to handle errors
792 my $s = Debbugs::DB->connect($options->{dsn} //
793 $options->{service}) or
794 die "Unable to connect to database: ";
797 sub read_release_file {
800 my $rfh = open_compressed_file($file) or
801 die "Unable to open $file for reading: $!";
807 if (s/^(\S+):\s*//) {
808 if ($1 eq 'SHA1'or $1 eq 'SHA256') {
815 my ($sha,$size,$f) = split /\s+/,$_;
816 next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
817 next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
818 my ($component,$arch,$package_source) = ($1,$2,$3);
819 $arch =~ s/binary-//;
820 next if exists $p_f{$component}{$arch};
821 $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
824 return (\%dist_info,\%p_f);
831 for my $bug (@bugs) {
832 my $stat = stat(getbugcomponent($bug,'summary',getbuglocation($bug,'summary')));
833 if (not defined $stat) {
834 print STDERR "Unable to stat $bug $!\n";
837 my $rs = $s->resultset('Bug')->search({id=>$bug})->single();
838 next if defined $rs and $stat->mtime <= $rs->last_modified()->epoch();
839 push @bugs_to_update, $bug;