cgi/projlist.cgi

   1 #!/usr/bin/perl
   2
   3 # projlist.cgi -- support for viewing a single owner's projects
   4 # Copyright (c) 2013 Kyle J. McKay.  All rights reserved.
   5 # Portions (c) Petr Baudis <pasky@suse.cz> and (c) Jan Krueger <jk@jk.gs>
   6 # License GPLv2+: GNU GPL version 2 or later.
   7 # www.gnu.org/licenses/gpl-2.0.html
   8 # This is free software: you are free to change and redistribute it.
   9 # There is NO WARRANTY, to the extent permitted by law.
  10
  11 use strict;
  12 use warnings;
  13
  14 use lib "__BASEDIR__";
  15 use Girocco::CGI;
  16 use Girocco::Config;
  17 use Girocco::Project;
  18 use Girocco::Util;
  19 use Digest::MD5 qw(md5_hex);
  20 binmode STDOUT, ':utf8';
  21
  22 my $style = <<'EOT';
  23 <style type="text/css">
  24 span.obfu:before {
  25         content: "\40";
  26 }
  27 </style>
  28 EOT
  29 my $gcgi = Girocco::CGI->new('Project List', undef, $style);
  30 my $cgi = $gcgi->cgi;
  31
  32 my $name = $gcgi->wparam('name');
  33
  34 unless (defined $name) {
  35         print "<p>I need the owner name as an argument now.</p>\n";
  36         exit;
  37 }
  38
  39 if ($cgi->param('mail')) {
  40         print "<p>Go away, bot.</p>";
  41         exit;
  42 }
  43
  44 if (!valid_email($name) && $name !~ /^[0-9a-fA-F]{32}$/) {
  45         print "<p>Invalid owner name. Go away, sorcerer.</p>\n";
  46         exit;
  47 }
  48
  49 if ($name =~ /^[0-9a-fA-F]{32}$/) {
  50         $name =~ tr/A-F/a-f/;
  51 } else {
  52         $name = md5_hex(lc($name));
  53 }
  54 my $displayname;
  55 my @projects = filedb_grep($Girocco::Config::projlist_cache_dir.'/gitproj.list',
  56         sub {
  57                 chomp;
  58                 my ($proj, $hash, $owner) = split(/ /, $_, 3);
  59                 if ($hash eq $name) {
  60                         $displayname = $owner unless $displayname;
  61                         $proj;
  62                 }
  63         }
  64 );
  65 if (!@projects) {
  66         print "<p>Invalid owner name. Go away, sorcerer.</p>\n";
  67         exit;
  68 }
  69
  70 $displayname =~ s,@,<span class="obfu"><span class="none"> </span></span>,;
  71 my $projectlist = projects_html_list({emptyok=>1, sizecol=>1, typecol=>1, changed=>1}, @projects);
  72 print <<EOT;
  73 <p>The owner '$displayname' has the following projects registered at this site:</p>
  74 $projectlist
  75 EOT