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 ".";
  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-f]{32}$/) {
  45         print "<p>Invalid owner name. Go away, sorcerer.</p>\n";
  46         exit;
  47 }
  48
  49 $name = md5_hex(lc($name)) if $name !~ /^[0-9a-f]{32}$/;
  50 my $displayname;
  51 my @projects = filedb_grep(jailed_file('/etc/gitweb.list'),
  52         sub {
  53                 chomp;
  54                 my ($proj, $owner) = split / /;
  55                 $owner = CGI::Util::unescape($owner);
  56                 if (md5_hex(lc($owner)) eq $name) {
  57                         $proj = CGI::Util::unescape($proj);
  58                         $proj =~ s/[.]git$//;
  59                         $displayname = $owner unless $displayname;
  60                         $proj;
  61                 }
  62         }
  63 );
  64 if (!@projects) {
  65         print "<p>Invalid owner name. Go away, sorcerer.</p>\n";
  66         exit;
  67 }
  68
  69 $displayname =~ s,@,<span class="obfu"></span>,;
  70 my $projectlist = projects_html_list({emptyok=>1, typecol=>1, changed=>1}, @projects);
  71 print <<EOT;
  72 <p>The owner '$displayname' has the following projects registered at this site:</p>
  73 $projectlist
  74 EOT