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 not defined $binarch or
441 $srcname !~ /^$config{package_name_re}$/o or
442 $binname !~ /^$config{package_name_re}$/o or
443 $srcver !~ /^$config{package_version_re}$/o or
444 $binver !~ /^$config{package_version_re}$/o
446 print STDERR "malformed debinfo: $file\n$_\n";
450 [$binname,$binver,$binarch,$srcname,$srcver,$ct_date];
457 for my $di (@debinfos) {
458 Debbugs::DB::Load::load_debinfo($s,@{$di}[0..5],\%cache);
461 $p->update($p->last_update()+@v) if $p;
466 sub add_maintainers {
467 my ($options,$opts,$p,$config,$argv) = @_;
469 my $s = db_connect($options);
470 my $maintainers = getsourcemaintainers() // {};
472 ## get all of the maintainers, and add the missing ones
473 my $maints = $s->resultset('Maintainer')->
474 get_maintainers(values %{$maintainers});
476 my @svs = $s->resultset('SrcVer')->
477 search({maintainer => undef
480 group_by => 'me.src_pkg, src_pkg.pkg',
481 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
482 columns => [qw(me.src_pkg src_pkg.pkg)],
485 $p->target(2+@svs) if $p;
488 if (exists $maintainers->{$sv->{src_pkg}{pkg}}) {
489 my $pkg = $sv->{src_pkg}{pkg};
490 my $maint = $maints->
491 {$maintainers->{$pkg}};
492 $s->txn_do(sub {$s->resultset('SrcVer')->
493 search({maintainer => undef,
494 'src_pkg.pkg' => $pkg
497 )->update({maintainer => $maint})
505 sub add_configuration {
506 my ($options,$opts,$p,$config,$argv) = @_;
508 my $s = db_connect($options);
513 for my $tag (@{$config{tags}}) {
515 $s->resultset('Tag')->find_or_create({tag => $tag});
518 for my $tag ($s->resultset('Tag')->search_rs()->all()) {
519 next if exists $tags{$tag->tag};
527 for my $sev_name (($config{default_severity},@{$config{severity_list}})) {
528 # add all severitites
529 my $sev = $s->resultset('Severity')->find_or_create({severity => $sev_name});
530 # mark strong severities
531 if (grep {$_ eq $sev_name} @{$config{strong_severities}}) {
534 $sev->ordering($order);
537 $sev_names{$sev_name} = 1;
539 # mark obsolete severities
540 for my $sev ($s->resultset('Severity')->search_rs()->all()) {
541 next if exists $sev_names{$sev->severity()};
548 my ($options,$opts,$p,$config,$argv) = @_;
551 my $s = db_connect($options);
552 my $dist_dir = IO::Dir->new($opts->{ftpdists});
554 grep { $_ !~ /^\./ and
555 -d $opts->{ftpdists}.'/'.$_ and
556 not -l $opts->{ftpdists}.'/'.$_
558 while (my $dist = shift @dist_names) {
559 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
560 my ($dist_info,$package_files) =
561 read_release_file($dist_dir.'/Release');
562 load_suite($s,$dist_info);
567 my ($options,$opts,$p,$config,$argv) = @_;
569 chdir($config->{spool_dir}) or
570 die "chdir $config->{spool_dir} failed: $!";
572 my $verbose = $options->{debug};
574 my $initialdir = "db-h";
576 if (defined $argv->[0] and $argv->[0] eq "archive") {
577 $initialdir = "archive";
579 my $s = db_connect($options);
581 walk_bugs(dirs => [(@{$argv}?@{$argv} : $initialdir)],
584 $verbose?(logging => \*STDERR):(),
588 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
589 if (not defined $stat) {
590 print STDERR "Unable to stat $bug $!\n";
593 if ($options{quick}) {
594 my $rs = $s->resultset('Bug')->
595 search({id=>$bug})->single();
596 return if defined $rs and
597 $stat->mtime <= $rs->last_modified()->epoch();
600 load_bug_log(db => $s,
604 die "failure while trying to load bug log $bug\n$@";
609 sub add_bugs_and_logs {
610 my ($options,$opts,$p,$config,$argv) = @_;
612 chdir($config->{spool_dir}) or
613 die "chdir $config->{spool_dir} failed: $!";
615 my $verbose = $options->{debug};
617 my $initialdir = "db-h";
619 if (defined $argv->[0] and $argv->[0] eq "archive") {
620 $initialdir = "archive";
622 my $s = db_connect($options);
628 walk_bugs(dirs => [(@{$argv}?@{$argv} : $initialdir)],
630 $verbose?(logging => \*STDERR):(),
635 if ($options{quick}) {
637 bugs_to_update($s,@bugs);
639 @bugs_to_update = @bugs;
643 for my $bug (@bugs_to_update) {
647 severities => \%severities,
653 die "failure while trying to load bug: $@";
655 for my $bug (@bugs) {
656 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
657 if (not defined $stat) {
658 print STDERR "Unable to stat $bug $!\n";
661 if ($options{quick}) {
662 my $rs = $s->resultset('Bug')->
663 search({id=>$bug})->single();
664 return if defined $rs and
665 $stat->mtime <= $rs->last_modified()->epoch();
668 load_bug_log(db => $s,
672 die "failure while trying to load bug log $bug\n$@";
678 handle_load_bug_queue(db=>$s,
685 my ($options,$opts,$p,$config,$argv) = @_;
687 my $dist_dir = IO::Dir->new($opts->{ftpdists});
689 grep { $_ !~ /^\./ and
690 -d $opts->{ftpdists}.'/'.$_ and
691 not -l $opts->{ftpdists}.'/'.$_
694 while (my $dist = shift @dist_names) {
695 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
696 my ($dist_info,$package_files) =
697 read_release_file($dist_dir.'/Release');
698 $s_p{$dist_info->{Codename}} = $package_files;
701 for my $suite (keys %s_p) {
702 for my $component (keys %{$s_p{$suite}}) {
703 $tot += scalar keys %{$s_p{$suite}{$component}};
706 $p->target($tot) if $p;
709 my $tot_suites = scalar keys %s_p;
711 my $completed_pkgs=0;
712 # parse packages files
713 for my $suite (keys %s_p) {
715 for my $component (keys %{$s_p{$suite}}) {
716 my @archs = keys %{$s_p{$suite}{$component}};
717 if (grep {$_ eq 'source'} @archs) {
718 @archs = ('source',grep {$_ ne 'source'} @archs);
720 for my $arch (@archs) {
721 my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or
722 die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
724 local $/ = ''; # paragraph mode
727 for my $field (qw(Package Maintainer Version Source)) {
728 /^\Q$field\E: (.*)/m;
731 next unless defined $pkg{Package} and
732 defined $pkg{Version};
733 push @pkgs,[$arch,$component,\%pkg];
737 my $s = db_connect($options);
741 $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
742 $completed_pkgs+@pkgs) if $p;
747 $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
748 $completed_pkgs += @pkgs;
754 sub handle_subcommand_arguments {
755 my ($argv,$args) = @_;
757 Getopt::Long::GetOptionsFromArray($argv,
762 for my $arg (keys %{$args}) {
763 next unless $args->{$arg};
764 my $r_arg = $arg; # real argument name
765 $r_arg =~ s/[=\|].+//g;
766 if (not defined $subopt->{$r_arg}) {
767 push @usage_errors, "You must give a $r_arg option";
770 pod2usage(join("\n",@usage_errors)) if @usage_errors;
775 my ($subcommand,$config,$options) = @_;
776 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
777 if ($options->{quick}) {
778 # If this is a quick run, just exit
779 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
782 print STDERR "Another debbugs-loadsql is running; stopping\n";
789 # connect to the database; figure out how to handle errors
791 my $s = Debbugs::DB->connect($options->{dsn} //
792 $options->{service}) or
793 die "Unable to connect to database: ";
796 sub read_release_file {
799 my $rfh = open_compressed_file($file) or
800 die "Unable to open $file for reading: $!";
806 if (s/^(\S+):\s*//) {
807 if ($1 eq 'SHA1'or $1 eq 'SHA256') {
814 my ($sha,$size,$f) = split /\s+/,$_;
815 next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
816 next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
817 my ($component,$arch,$package_source) = ($1,$2,$3);
818 $arch =~ s/binary-//;
819 next if exists $p_f{$component}{$arch};
820 $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
823 return (\%dist_info,\%p_f);
830 for my $bug (@bugs) {
831 my $stat = stat(getbugcomponent($bug,'summary',getbuglocation($bug,'summary')));
832 if (not defined $stat) {
833 print STDERR "Unable to stat $bug $!\n";
836 my $rs = $s->resultset('Bug')->search({id=>$bug})->single();
837 next if defined $rs and $stat->mtime <= $rs->last_modified()->epoch();
838 push @bugs_to_update, $bug;