view.cgi

#!/usr/local/bin/perl
#
# view.cgi - Source Code Viewer CGI
# version 0.01
#
# Copyright (C) 2006 palmo < palmonger at gmail dot com >
# License Terms: http://creativecommons.org/licenses/by-nc/2.1/jp/
#

use strict;
use CGI::Carp qw(fatalsToBrowser);
use HTML::Template;
use Text::Highlight;

# ----
# 設定
# ----

# 使用するテンプレートファイルのパス
my $tmpl_path = "view.tmpl";

# 拡張子からファイルタイプへの関連付け
# ファイルタイプは色分けに利用される
my %file_types = (
  pl   => 'Perl',
  pm   => 'Perl',
  cgi  => 'Perl',
  tmpl => 'HTML',
);

# 渡されたパスが有効かどうか調べる為の正規表現
# 絶対パス、もしくは ../ などを含む相対パスは無効
my $allowed_path = q!^\w[\w\/]+\.(! . join('|', keys %file_types) . q!)$!;

# 実際に読み込まれるファイルのベースとなるパス
my $base_path = "./";

# ------------
# サブルーチン
# ------------

# 読み込みが許可されたパスなら真を返す
sub is_allowed_path($) {
  my $fpath = shift;
  return ($fpath && $fpath =~ /$allowed_path/);
}

# ファイルに関連付けられたファイルタイプを返す
# 関連付けられていない場合は undef を返す
sub get_file_type($) {
  my $fpath = shift;

  my $ftype = undef;
  if ($fpath && $fpath =~ /\.([^.]+?)$/) {
    my $ext = lc($1);
    $ftype = $file_types{$ext} if exists $file_types{$ext};
  }
  return $ftype;
}

# ソースファイルを読み込んでマークアップされた内容を返す
# 読み込めなかった場合は undef を返す
sub load_source_file($$) {
  my ($fpath, $ftype) = @_;

  open IN, $fpath or return undef;
  my $content = join "", <IN>;
  close IN;

  my $th = Text::Highlight->new(wrapper => "%s");
  return $th->highlight($ftype, $content);
}

# ----------
# メイン処理
# ----------
{
  my $tmpl = HTML::Template->new(filename => $tmpl_path);

  my $fname = $ENV{'QUERY_STRING'};   # 渡されたファイル名
  my $fpath = "$base_path$fname";     # 実際のファイルパス
  my $ftype = get_file_type($fpath);  # 関連付けられたファイルタイプ

  # 読み込み可能で関連付けられたパスなら内容を読み込んで設定
  if (is_allowed_path($fname) && -r $fpath && $ftype) {
    $tmpl->param(
      FILENAME => $fname,
      FILEPATH => $fpath,
      FILETYPE => $ftype,
      CODE => load_source_file($fpath, $ftype) || "",
    );
  }

  # ページを出力
  my $output = $tmpl->output() || "Template Output Error";
  print "Content-Type: text/html\n";
  print "Content-Length: " . length($output) . "\n\n";
  print $output;
}

__END__

view.cgi を開く