yarrg/web/source.tar.gz

   1 %# This is part of the YARRG website.  YARRG is a tool and website
   2 %# for assisting players of Yohoho Puzzle Pirates.
   3 %#
   4 %# Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
   5 %# Copyright (C) 2009 Clare Boothby
   6 %#
   7 %#  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
   8 %#  The YARRG website is covered by the GNU Affero GPL v3 or later, which
   9 %#   basically means that every installation of the website will let you
  10 %#   download the source.
  11 %#
  12 %# This program is free software: you can redistribute it and/or modify
  13 %# it under the terms of the GNU Affero General Public License as
  14 %# published by the Free Software Foundation, either version 3 of the
  15 %# License, or (at your option) any later version.
  16 %#
  17 %# This program is distributed in the hope that it will be useful,
  18 %# but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 %# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 %# GNU Affero General Public License for more details.
  21 %#
  22 %# You should have received a copy of the GNU Affero General Public License
  23 %# along with this program.  If not, see <http://www.gnu.org/licenses/>.
  24 %#
  25 %# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
  26 %# are used without permission.  This program is not endorsed or
  27 %# sponsored by Three Rings.
  28 %#
  29 %#
  30 %# This Mason component allows visitors to the YARRG website to download
  31 %# the YARRG website's source code.
  32 %#
  33 <%perl>
  34 use IO::Pipe;
  35 use CommodsWeb;
  36
  37 $r->content_type('application/octet-stream');
  38 $m->flush_buffer();
  39
  40 $ENV{'YPPSC_YARRG_SRCBASE'}= $sourcebasedir;
  41 my $pipe= new IO::Pipe or die $!;
  42 my $pid= fork();  defined $pid or die $!;
  43 if (!$pid) {
  44         $pipe->writer();
  45         exec '/bin/sh','-c','
  46                 cd -P "$YPPSC_YARRG_SRCBASE"
  47                 (
  48                  git-ls-files -z;
  49                  git-ls-files -z --others --exclude-from=.gitignore;
  50                  if test -d .git; then find .git -print0; fi
  51                 ) | cpio -Hustar -o --quiet -0 -R 1000:1000
  52         ';
  53         die $!;
  54 }
  55 $pipe->reader();
  56
  57 my ($d, $l);
  58 while ($l= read $pipe, $d, 65536) {
  59         print $d;
  60         $m->flush_buffer();
  61 }
  62 waitpid $pid,0;
  63 defined $l or die "read pipe $!";
  64 $pipe->error and die "pipe error $!";
  65 close $pipe;
  66 # deliberately ignore errors
  67
  68 </%perl>