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: "@";
  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($name) if $name !~ /^[0-9a-f]{32}$/;
  50 my $displayname;
  51
  52 open F, '<', "$Girocco::Config::chroot/etc/gitweb.list"
  53         or die "not found project list, that's really weird!";
  54
  55 my @projects = ();
  56 while (<F>) {
  57         chomp;
  58         my ($proj, $owner) = split / /;
  59         $owner = CGI::Util::unescape($owner);
  60         if (md5_hex($owner) eq $name) {
  61                 $proj = CGI::Util::unescape($proj);
  62                 $proj =~ s/[.]git$//;
  63                 push @projects, $proj;
  64                 $displayname = $owner unless $displayname;
  65         }
  66 }
  67 close F;
  68 @projects or die "not found owner's projects, that's really weird!";
  69
  70 $displayname =~ s,@,<span class="obfu"></span>,;
  71 my $projectlist = projects_html_list({emptyok=>1, typecol=>1}, @projects);
  72 print <<EOT;
  73 <p>The owner '$displayname' has the following projects registered at this site:</p>
  74 $projectlist
  75 EOT