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.'/../';
141 use Debbugs::Common (qw(checkpid lockpid get_hashname getparsedaddrs),
142 qw(getbugcomponent make_list getsourcemaintainers),
144 qw(hash_slice open_compressed_file),);
145 use Debbugs::Config qw(:config);
146 use Debbugs::Status qw(read_bug split_status_fields);
149 use Debbugs::DB::Load qw(:load_bug :load_package :load_suite);
157 use IO::Uncompress::AnyUncompress;
158 use Encode qw(decode_utf8);
159 use List::AllUtils qw(natatime);
168 service => $config{debbugs_db},
172 Getopt::Long::Configure('pass_through');
173 GetOptions(\%options,
179 'spool_dir|spool-dir=s',
182 'debug|d+','help|h|?','man|m');
183 Getopt::Long::Configure('default');
185 pod2usage() if $options{help};
186 pod2usage({verbose=>2}) if $options{man};
188 $DEBUG = $options{debug};
191 ('bugs' => {function => \&add_bugs,
192 arguments => {'preload' => 0,
196 'versions' => {function => \&add_versions,
198 'debinfo' => {function => \&add_debinfo,
199 arguments => {'0|null' => 0,
200 'debinfo_dir|debinfo-dir=s' => 0,
203 'maintainers' => {function => \&add_maintainers,
205 'configuration' => {function => \&add_configuration,
207 'suites' => {function => \&add_suite,
208 arguments => {'ftpdists=s' => 1,
211 'logs' => {function => \&add_logs,
213 'bugs_and_logs' => {function => \&add_bugs_and_logs,
215 'packages' => {function => \&add_packages,
216 arguments => {'ftpdists=s' => 1,
220 'help' => {function => sub {pod2usage({verbose => 2});}}
224 $options{verbose} = $options{verbose} - $options{quiet};
226 if ($options{progress}) {
227 eval "use Term::ProgressBar";
228 push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
232 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
234 if (exists $options{sysconfdir}) {
235 if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
236 delete $ENV{PGSYSCONFDIR};
238 $ENV{PGSYSCONFDIR} = $options{sysconfdir};
242 if (exists $options{spool_dir} and defined $options{spool_dir}) {
243 $config{spool_dir} = $options{spool_dir};
247 if ($options{progress}) {
248 $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
249 warn "Unable to initialize progress bar: $@" if not $prog_bar;
253 my ($subcommand) = shift @ARGV;
254 if (not defined $subcommand) {
255 $subcommand = 'help';
256 print STDERR "You must provide a subcommand; displaying usage.\n";
258 } elsif (not exists $subcommands{$subcommand}) {
259 print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
263 binmode(STDOUT,':encoding(UTF-8)');
264 binmode(STDERR,':encoding(UTF-8)');
267 handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
268 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
271 my ($options,$opts,$p,$config,$argv) = @_;
272 chdir($config->{spool_dir}) or
273 die "chdir $config->{spool_dir} failed: $!";
275 my $verbose = $options->{debug};
280 } elsif (not defined $opts->{bugs}) {
283 $opts->{bugs} //= [];
285 my $s = db_connect($options);
292 if ($opts->{preload}) {
294 walk_bugs(dirs => [@dirs],
295 bugs => $opts->{bugs},
299 bugs_per_call => 10000
301 $s->resultset('Bug')->quick_insert_bugs(@bugs);
303 walk_bugs(dirs => [@dirs],
304 bugs => $opts->{bugs},
306 $verbose?(logging=>\*STDERR):(),
311 if ($options{quick}) {
313 bugs_to_update($s,@bugs);
315 @bugs_to_update = @bugs;
319 for my $bug (@bugs_to_update) {
323 severities => \%severities,
329 die "failure while trying to load bug: $@";
334 handle_load_bug_queue(db => $s,
339 my ($options,$opts,$p,$config,$argv) = @_;
341 my $s = db_connect($options);
343 my @files = @{$argv};
344 $p->target(scalar @files) if $p;
345 for my $file (@files) {
346 my $fh = IO::File->new($file,'r') or
347 die "Unable to open $file for reading: $!";
352 next unless length $_;
353 if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
354 push @versions, [$1,$2];
359 for my $i (reverse 0..($#versions)) {
361 if (not defined $src_pkgs{$versions[$i][0]}) {
362 $src_pkgs{$versions[$i][0]} =
363 $s->resultset('SrcPkg')->
364 get_or_create_src_pkg_id($versions[$i][0]);
366 $sp = $src_pkgs{$versions[$i][0]};
367 # There's probably something wrong if the source package
368 # doesn't exist, but we'll skip it for now
369 last if not defined $sp;
370 my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp,
371 ver => $versions[$i][1],
373 last if not defined $sv;
374 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
375 $sv->update({based_on => $ancestor_sv})
377 $ancestor_sv = $sv->id();
385 my ($options,$opts,$p,$config,$argv) = @_;
387 my @files = @{$argv};
388 if (exists $opts->{debinfo_dir} and not @files) {
390 if (-f $_ and /\.debinfo$/) {
391 push @files, $File::Find::name;
400 local $/ = "\0" if $opts->{0};
402 s/\n$// unless $opts->{0};
403 s/\0$// if $opts->{0};
408 return unless @files;
409 my $s = db_connect($options);
410 $p->target(scalar @files) if $p;
411 my $it = natatime 100, @files;
412 while (my @v = $it->()) {
415 FILE: for my $file (@v) {
416 my $fh = IO::File->new($file,'r') or
417 die "Unable to open $file for reading: $!";
418 my $f_stat = stat($file);
419 my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime);
423 next unless length $_;
424 my ($binname, $binver, $binarch, $srcname, $srcver) = split;
425 # if $srcver is not defined, this is probably a broken
426 # .debinfo file [they were causing #686106, see commit
427 # 49c85ab8 in dak.] Basically, $binarch didn't get put into
428 # the file, so we'll fudge it from the filename.
429 if (not defined $srcver) {
430 ($srcname,$srcver) = ($binarch,$srcname);
431 ($binarch) = $file =~ /_([a-z0-9-]+)\.debinfo/;
433 # It turns out that there are debinfo files which are horribly
434 # screwed up, and have junk in them. We need to discard them
436 if (not defined $srcname or
437 not defined $srcver or
438 not defined $binname or
439 not defined $binver or
440 $srcname !~ /^$config{package_name_re}$/o or
441 $binname !~ /^$config{package_name_re}$/o or
442 $srcver !~ /^$config{package_version_re}$/o or
443 $binver !~ /^$config{package_version_re}$/o
445 print STDERR "malformed debinfo: $file\n";
449 [$binname,$binver,$binarch,$srcname,$srcver,$ct_date];
456 for my $di (@debinfos) {
457 Debbugs::DB::Load::load_debinfo($s,@{$di}[0..5],\%cache);
460 $p->update($p->last_update()+@v) if $p;
465 sub add_maintainers {
466 my ($options,$opts,$p,$config,$argv) = @_;
468 my $s = db_connect($options);
469 my $maintainers = getsourcemaintainers() // {};
471 ## get all of the maintainers, and add the missing ones
472 my $maints = $s->resultset('Maintainer')->
473 get_maintainers(values %{$maintainers});
475 my @svs = $s->resultset('SrcVer')->
476 search({maintainer => undef
479 group_by => 'me.src_pkg, src_pkg.pkg',
480 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
481 columns => [qw(me.src_pkg src_pkg.pkg)],
484 $p->target(2+@svs) if $p;
487 if (exists $maintainers->{$sv->{src_pkg}{pkg}}) {
488 my $pkg = $sv->{src_pkg}{pkg};
489 my $maint = $maints->
490 {$maintainers->{$pkg}};
491 $s->txn_do(sub {$s->resultset('SrcVer')->
492 search({maintainer => undef,
493 'src_pkg.pkg' => $pkg
496 )->update({maintainer => $maint})
504 sub add_configuration {
505 my ($options,$opts,$p,$config,$argv) = @_;
507 my $s = db_connect($options);
512 for my $tag (@{$config{tags}}) {
514 $s->resultset('Tag')->find_or_create({tag => $tag});
517 for my $tag ($s->resultset('Tag')->search_rs()->all()) {
518 next if exists $tags{$tag->tag};
526 for my $sev_name (($config{default_severity},@{$config{severity_list}})) {
527 # add all severitites
528 my $sev = $s->resultset('Severity')->find_or_create({severity => $sev_name});
529 # mark strong severities
530 if (grep {$_ eq $sev_name} @{$config{strong_severities}}) {
533 $sev->ordering($order);
536 $sev_names{$sev_name} = 1;
538 # mark obsolete severities
539 for my $sev ($s->resultset('Severity')->search_rs()->all()) {
540 next if exists $sev_names{$sev->severity()};
547 my ($options,$opts,$p,$config,$argv) = @_;
550 my $s = db_connect($options);
551 my $dist_dir = IO::Dir->new($opts->{ftpdists});
553 grep { $_ !~ /^\./ and
554 -d $opts->{ftpdists}.'/'.$_ and
555 not -l $opts->{ftpdists}.'/'.$_
557 while (my $dist = shift @dist_names) {
558 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
559 my ($dist_info,$package_files) =
560 read_release_file($dist_dir.'/Release');
561 load_suite($s,$dist_info);
566 my ($options,$opts,$p,$config,$argv) = @_;
568 chdir($config->{spool_dir}) or
569 die "chdir $config->{spool_dir} failed: $!";
571 my $verbose = $options->{debug};
573 my $initialdir = "db-h";
575 if (defined $argv->[0] and $argv->[0] eq "archive") {
576 $initialdir = "archive";
578 my $s = db_connect($options);
580 walk_bugs(dirs => [(@{$argv}?@{$argv} : $initialdir)],
583 $verbose?(logging => \*STDERR):(),
587 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
588 if (not defined $stat) {
589 print STDERR "Unable to stat $bug $!\n";
592 if ($options{quick}) {
593 my $rs = $s->resultset('Bug')->
594 search({id=>$bug})->single();
595 return if defined $rs and
596 $stat->mtime <= $rs->last_modified()->epoch();
599 load_bug_log(db => $s,
603 die "failure while trying to load bug log $bug\n$@";
608 sub add_bugs_and_logs {
609 my ($options,$opts,$p,$config,$argv) = @_;
611 chdir($config->{spool_dir}) or
612 die "chdir $config->{spool_dir} failed: $!";
614 my $verbose = $options->{debug};
616 my $initialdir = "db-h";
618 if (defined $argv->[0] and $argv->[0] eq "archive") {
619 $initialdir = "archive";
621 my $s = db_connect($options);
627 walk_bugs(dirs => [(@{$argv}?@{$argv} : $initialdir)],
629 $verbose?(logging => \*STDERR):(),
634 if ($options{quick}) {
636 bugs_to_update($s,@bugs);
638 @bugs_to_update = @bugs;
642 for my $bug (@bugs_to_update) {
646 severities => \%severities,
652 die "failure while trying to load bug: $@";
654 for my $bug (@bugs) {
655 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
656 if (not defined $stat) {
657 print STDERR "Unable to stat $bug $!\n";
660 if ($options{quick}) {
661 my $rs = $s->resultset('Bug')->
662 search({id=>$bug})->single();
663 return if defined $rs and
664 $stat->mtime <= $rs->last_modified()->epoch();
667 load_bug_log(db => $s,
671 die "failure while trying to load bug log $bug\n$@";
677 handle_load_bug_queue(db=>$s,
684 my ($options,$opts,$p,$config,$argv) = @_;
686 my $dist_dir = IO::Dir->new($opts->{ftpdists});
688 grep { $_ !~ /^\./ and
689 -d $opts->{ftpdists}.'/'.$_ and
690 not -l $opts->{ftpdists}.'/'.$_
693 while (my $dist = shift @dist_names) {
694 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
695 my ($dist_info,$package_files) =
696 read_release_file($dist_dir.'/Release');
697 $s_p{$dist_info->{Codename}} = $package_files;
700 for my $suite (keys %s_p) {
701 for my $component (keys %{$s_p{$suite}}) {
702 $tot += scalar keys %{$s_p{$suite}{$component}};
705 $p->target($tot) if $p;
708 my $tot_suites = scalar keys %s_p;
710 my $completed_pkgs=0;
711 # parse packages files
712 for my $suite (keys %s_p) {
714 for my $component (keys %{$s_p{$suite}}) {
715 my @archs = keys %{$s_p{$suite}{$component}};
716 if (grep {$_ eq 'source'} @archs) {
717 @archs = ('source',grep {$_ ne 'source'} @archs);
719 for my $arch (@archs) {
720 my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or
721 die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
723 local $/ = ''; # paragraph mode
726 for my $field (qw(Package Maintainer Version Source)) {
727 /^\Q$field\E: (.*)/m;
730 next unless defined $pkg{Package} and
731 defined $pkg{Version};
732 push @pkgs,[$arch,$component,\%pkg];
736 my $s = db_connect($options);
740 $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
741 $completed_pkgs+@pkgs) if $p;
746 $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
747 $completed_pkgs += @pkgs;
753 sub handle_subcommand_arguments {
754 my ($argv,$args) = @_;
756 Getopt::Long::GetOptionsFromArray($argv,
761 for my $arg (keys %{$args}) {
762 next unless $args->{$arg};
763 my $r_arg = $arg; # real argument name
764 $r_arg =~ s/[=\|].+//g;
765 if (not defined $subopt->{$r_arg}) {
766 push @usage_errors, "You must give a $r_arg option";
769 pod2usage(join("\n",@usage_errors)) if @usage_errors;
774 my ($subcommand,$config,$options) = @_;
775 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
776 if ($options->{quick}) {
777 # If this is a quick run, just exit
778 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
781 print STDERR "Another debbugs-loadsql is running; stopping\n";
788 # connect to the database; figure out how to handle errors
790 my $s = Debbugs::DB->connect($options->{dsn} //
791 $options->{service}) or
792 die "Unable to connect to database: ";
795 sub read_release_file {
798 my $rfh = open_compressed_file($file) or
799 die "Unable to open $file for reading: $!";
805 if (s/^(\S+):\s*//) {
806 if ($1 eq 'SHA1'or $1 eq 'SHA256') {
813 my ($sha,$size,$f) = split /\s+/,$_;
814 next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
815 next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
816 my ($component,$arch,$package_source) = ($1,$2,$3);
817 $arch =~ s/binary-//;
818 next if exists $p_f{$component}{$arch};
819 $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
822 return (\%dist_info,\%p_f);
829 for my $bug (@bugs) {
830 my $stat = stat(getbugcomponent($bug,'summary',getbuglocation($bug,'summary')));
831 if (not defined $stat) {
832 print STDERR "Unable to stat $bug $!\n";
835 my $rs = $s->resultset('Bug')->search({id=>$bug})->single();
836 next if defined $rs and $stat->mtime <= $rs->last_modified()->epoch();
837 push @bugs_to_update, $bug;