/[suikacvs]/www/namazu/filter/gzip.pl
Suika

Contents of /www/namazu/filter/gzip.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (download) (vendor branch)
Fri Nov 30 07:56:45 2001 UTC (22 years, 5 months ago) by wakaba
Branch: MAIN, wakaba
CVS Tags: initial, HEAD
Changes since 1.1: +0 -0 lines
File MIME type: text/plain

1 #
2 # -*- Perl -*-
3 # $Id: gzip.pl,v 1.16 2000/03/23 10:41:04 knok Exp $
4 # Copyright (C) 2000 Namazu Project All rights reserved ,
5 # This is free software with ABSOLUTELY NO WARRANTY.
6 #
7 # This program is free software; you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either versions 2, or (at your option)
10 # any later version.
11 #
12 # This program is distributed in the hope that it will be useful
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
20 # 02111-1307, USA
21 #
22 # This file must be encoded in EUC-JP encoding
23 #
24
25 package gzip;
26 use strict;
27 require 'util.pl';
28
29 my $gzippath = undef;
30
31 sub mediatype() {
32 return ('application/x-gzip');
33 }
34
35 sub status() {
36 return 'yes' if (util::checklib('Compress/Zlib.pm'));
37 $gzippath = util::checkcmd('gzip');
38 return 'yes' if (defined $gzippath);
39 return 'no';
40 }
41
42 sub recursive() {
43 return 1;
44 }
45
46 sub pre_codeconv() {
47 return 0;
48 }
49
50 sub post_codeconv () {
51 return 0;
52 }
53
54 sub add_magic ($) {
55 return;
56 }
57
58 sub filter ($$$$$) {
59 my ($orig_cfile, $cont, $weighted_str, $headings, $fields)
60 = @_;
61 my $err = undef;
62
63 if (util::checklib('Compress/Zlib.pm')) {
64 $err = filter_xs($cont);
65 } else {
66 $err = filter_file($cont);
67 }
68 return $err;
69 }
70
71 sub filter_file ($) {
72 my ($contref) = @_;
73
74 my $tmpfile = util::tmpnam('NMZ.gzip');
75 my $fh = util::efopen("|$gzippath -cd > $tmpfile");
76
77 util::vprint("Processing gzip file ... (using '$gzippath')\n");
78
79 print $fh $$contref;
80 undef $fh;
81 $fh = util::efopen("$tmpfile");
82 my $size = util::filesize($fh);
83 if ($size > $conf::FILE_SIZE_MAX) {
84 return 'too_large_gzipped_file';
85 }
86 $$contref = util::readfile($fh);
87 $fh->close();
88 unlink($tmpfile);
89 return undef;
90 }
91
92 sub filter_xs ($) {
93 my ($contref) = @_;
94
95 util::vprint("Processing gzip file ... (using Compress::Zlib)\n");
96
97 eval 'use Compress::Zlib;';
98
99 my $offset = 0;
100 $offset += 3;
101 my $flags = unpack('C', substr($$contref, $offset, 1));
102 $offset += 1;
103 $offset += 6;
104 $$contref = substr($$contref, $offset);
105 $$contref = substr($$contref, 2) if ($flags & 0x04);
106 $$contref =~ s/^[^\0]*\0// if ($flags & 0x08);
107 $$contref =~ s/^[^\0]*\0// if ($flags & 0x10);
108 $$contref = substr($$contref, 2) if ($flags & 0x02);
109
110 my $zl = inflateInit(-WindowBits => - MAX_WBITS());
111 my ($inf, $stat) = $zl->inflate($$contref);
112 if ($stat == Z_OK() or $stat == Z_STREAM_END()) {
113 $$contref = $inf;
114 } else {
115 $$contref = '';
116 return 'Bad compressed data.';
117 }
118
119 return undef;
120 }
121
122 1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24