Bug#815202: packages: machines and sponsors information is outdated

Stéphane Blondon <[email protected]> Tue, 5 Apr 2016 03:05:03 +0200

Newsgroups	gmane.linux.debian.devel.www
Message-ID	<57030F3F.8050605__31361.4794089974$1459818415$gmane$org@gmail.com>

Le 01/04/2016 06:43, Paul Wise a écrit :
> DSA would very much like to kill the existing codebase behind the
> db.d.o website in favour of a rewrite in django:
> 
> https://github.com/Debian/ud

There are no commit since two years, so I'm not sure it's still alive.



> The existing codebase is available here:
> 
> https://anonscm.debian.org/cgit/mirror/userdir-ldap-cgi.git/tree/machines.cgi

I tried to extract the useful code from the script. It depends on the
libnet-ldapapi-perl package and the configuration of the machine which
is running the LDAP.

The syntax is correct but I can't run it on the machine (I don't have
the access rights).

However, I wonder if this perl script is the best strategy:

- Perhaps providing the full data in JSON format by db.d.o would provide
an easy access for several Debian services/tools.
- Or providing a python script which could be reused by the django site
in the future?

Whatever the chosen solution, I can't try to it due to lack of access
rights. (I think it's normal I don't have it.)

-- 
Stéphane

packagemachines.pl (application/x-perl, 3 KB)

#!/usr/bin/perl

use strict;

use Net::LDAP qw(LDAP_SUCCESS LDAP_PROTOCOL_ERROR);


my %summaryattrs = ('hostname' => 'Host name',
		 'host'     => 'just for a link',
		 'description' => 'Description',
		 'architecture' => 'Architecture',
		 'status' => 'Status',
		 'access' => 'Access',
		 'sponsor' => 'Sponsor',
		 'purpose' => 'Purpose');


# Configuration
# -------------

my $configfile = "/etc/userdir-ldap/userdir-ldap.conf";

sub ReadConfigFile {
  # reads a config file and results a hashref with the results
  my (%config, $attr, $setting);
  open (F, "<$configfile") || die("Cannot open $configfile: $!");
  while (<F>) {
    chomp;
    if ((!/^\s*#/) && ($_ ne "")) {
      # Chop off any trailing comments
      s/#.*//;
      /([^=]+)=(.*)/;
      ($attr, $setting) = ($1, $2);
      $setting =~ s/"//g; #"
      $setting =~ s/;$//;
      $attr =~ s/^\s+//; $attr =~ s/\s+$//;
      $setting =~ s/^\s+//; $setting =~ s/\s+$//;      
      $config{$attr} = $setting;
    }
  }
  close F;
  return %config;
}


my %config = &ReadConfigFile;

my ($ldap, $mesg, $dn, $entries, $data, %output, $key, $hostlist, $hostdetails, $selected, %summary);
sub DieHandler {
  $ldap->unbind if (defined($ldap));
}


# Connect to LDAP
# ---------------

sub UpgradeConnection($) {
  my ($ldap) = @_;
  my $mesg = $ldap->start_tls(
                          verify => 'require',
                          cafile => $config{sslcafile},
                          );
  $mesg->sync;
  if ($mesg->code != LDAP_SUCCESS) {
    print $mesg->error;
    exit(1);
  };
};


$ldap = Net::LDAP->new($config{ldaphost}) || &Util::HTMLError($!);
&UpgradeConnection($ldap) unless $config{usessl} eq 'False';

$ldap->bind;



# Search
# ------

# in the purpose field [[host|some other text]] (where some other text is optional)
# makes a hyperlink on the web thing. we now also add these hosts to the ssh known_hosts
# file.  But so that we don't have to add everything we link we can add an asterisk
# and say [[*... to ignore it.  In order to be able to add stuff to ssh without
# http linking it we also support [[-hostname]] entries.
#
# sponsors are also wikified like purpose.  maybe others as well
sub item_uplist($) {
	my ($items) = @_;
	my $out = undef;
	my(@tmp) = @$items;

	if (scalar @tmp>= 1) {
		$out = "<ul>".
			join("", map { 
				"<li>".wiki_link($_)."</li>\n";
			  } sort {my $A=$a; my $B=$b; $A =~ s/[\[\]\*]//g; $B =~ s/[\[\]\*]//g; $A cmp $B} @tmp
			).
			"</ul>";
	}
	return $out;
}


$mesg = $ldap->search(base  => $config{hostbasedn}, filter => 'host=*');
$mesg->code && die($mesg->error);
$entries = $mesg->as_struct;

my @package_machine_names = ();


foreach $dn (sort {$entries->{$a}->{host}->[0] cmp $entries->{$b}->{host}->[0]} keys(%$entries)) {
  my $data = $entries->{$dn};

  my $purpose = item_uplist($data->{purpose});
  if (index($purpose, "packages.debian.org") != -1) {
      push(@package_machine_names, $data->{hostname});
  } 

}

$ldap->unbind();


# the names should be in @package_machine_names

signature.asc (application/pgp-signature, 819 B)