~ubuntu-branches/ubuntu/feisty/libapache2-mod-perl2/feisty-security

« back to all changes in this revision

Viewing changes to lib/Apache/ParseSource.pm

  • Committer: Bazaar Package Importer
  • Author(s): Adam Conrad
  • Date: 2004-08-19 06:23:48 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040819062348-jxl4koqbtvgm8v2t
Tags: 1.99.14-4
Remove the LFS CFLAGS, and build-dep against apache2-*-dev (>= 2.0.50-10)
as we're backing out of the apache2/apr ABI transition.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# Copyright 2001-2004 The Apache Software Foundation
 
2
#
 
3
# Licensed under the Apache License, Version 2.0 (the "License");
 
4
# you may not use this file except in compliance with the License.
 
5
# You may obtain a copy of the License at
 
6
#
 
7
#     http://www.apache.org/licenses/LICENSE-2.0
 
8
#
 
9
# Unless required by applicable law or agreed to in writing, software
 
10
# distributed under the License is distributed on an "AS IS" BASIS,
 
11
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 
12
# See the License for the specific language governing permissions and
 
13
# limitations under the License.
 
14
#
1
15
package Apache::ParseSource;
2
16
 
3
17
use strict;
4
18
use Apache::Build ();
5
19
use Config;
 
20
use File::Basename;
 
21
use File::Spec::Functions qw(catdir);
6
22
 
7
23
our $VERSION = '0.02';
8
24
 
42
58
{
43
59
    package Apache::ParseSource::Scan;
44
60
 
45
 
    our @ISA = qw(C::Scan);
 
61
    our @ISA = qw(ModPerl::CScan);
46
62
 
47
63
    sub get {
48
64
        local $SIG{__DIE__} = \&Carp::confess;
54
70
    'CORE_PRIVATE',   #so we get all of apache
55
71
    'MP_SOURCE_SCAN', #so we can avoid some c-scan barfing
56
72
    '_NETINET_TCP_H', #c-scan chokes on netinet/tcp.h
57
 
    'APR_OPTIONAL_H', #c-scan chokes on apr_optional.h
 
73
 #   'APR_OPTIONAL_H', #c-scan chokes on apr_optional.h
58
74
    'apr_table_do_callback_fn_t=void', #c-scan chokes on function pointers
59
75
);
60
76
 
 
77
 
 
78
# some types c-scan failing to resolve
 
79
push @c_scan_defines, map { "$_=void" } 
 
80
    qw(PPADDR_t PerlExitListEntry modperl_tipool_vtbl_t);
 
81
 
61
82
sub scan {
62
 
    require C::Scan;
63
 
    C::Scan->VERSION(0.75);
 
83
    require ModPerl::CScan;
 
84
    ModPerl::CScan->VERSION(0.75);
64
85
    require Carp;
65
86
 
66
87
    my $self = shift;
67
88
 
68
 
    my $c = C::Scan->new(filename => $self->{scan_filename});
69
 
 
70
 
    $c->set(includeDirs => $self->includes);
 
89
    my $c = ModPerl::CScan->new(filename => $self->{scan_filename});
 
90
 
 
91
    my $includes = $self->includes;
 
92
 
 
93
    # where to find perl headers, but we don't want to parse them otherwise
 
94
    my $perl_core_path = catdir $Config{installarchlib}, "CORE";
 
95
    push @$includes, $perl_core_path;
 
96
 
 
97
    $c->set(includeDirs => $includes);
71
98
 
72
99
    my @defines = @c_scan_defines;
73
100
 
98
125
 
99
126
    require File::Find;
100
127
 
101
 
    my(@dirs) = $self->include_dirs;
102
 
 
103
 
    unless (-d $dirs[0]) {
104
 
        die "could not find include directory";
105
 
    }
106
 
 
107
 
    my @includes;
108
 
    my $unwanted = join '|', qw(ap_listen internal version
109
 
                                apr_optional mod_include mod_cgi mod_proxy
110
 
                                mod_ssl ssl_ apr_anylock apr_rmm
111
 
                                ap_config mod_log_config);
112
 
 
 
128
    my @includes = ();
 
129
    # don't pick preinstalled mod_perl headers if any, but pick the rest
 
130
    {
 
131
        my @dirs = $self->include_dirs;
 
132
        die "could not find include directory (build the project first)"
 
133
            unless -d $dirs[0];
 
134
 
 
135
        my $unwanted = join '|', qw(ap_listen internal version
 
136
                                    apr_optional mod_include mod_cgi
 
137
                                    mod_proxy mod_ssl ssl_ apr_anylock
 
138
                                    apr_rmm ap_config mod_log_config
 
139
                                    mod_perl modperl_);
 
140
        my $unwanted = qr|^$unwanted|;
 
141
        my $wanted = '';
 
142
 
 
143
        push @includes, find_includes_wanted($wanted, $unwanted, @dirs);
 
144
    }
 
145
 
 
146
    # now add the live mod_perl headers (to make sure that we always
 
147
    # work against the latest source)
 
148
    {
 
149
        my @dirs = map { catdir $self->config->{cwd}, $_ }
 
150
            catdir(qw(src modules perl)), 'xs';
 
151
 
 
152
        my $unwanted = '';
 
153
        my $wanted = join '|', qw(mod_perl modperl_);
 
154
        $wanted = qr|^$wanted|;
 
155
 
 
156
        push @includes, find_includes_wanted($wanted, $unwanted, @dirs);
 
157
    }
 
158
 
 
159
    # now reorg the header files list, so the fragile scan won't choke
 
160
    my @apr = ();
 
161
    my @mp = ();
 
162
    my @rest = ();
 
163
    for (@includes) {
 
164
        if (/mod_perl.h$/) {
 
165
            # mod_perl.h needs to be included before other mod_perl
 
166
            # headers
 
167
            unshift @mp, $_;
 
168
        }
 
169
        elsif (/modperl_\w+.h$/) {
 
170
            push @mp, $_;
 
171
        }
 
172
        elsif (/apr_\w+\.h$/ ) {
 
173
            # apr headers need to be included first
 
174
            push @apr, $_;
 
175
        }
 
176
        else {
 
177
            push @rest, $_;
 
178
        }
 
179
    }
 
180
    @includes = (@apr, @rest, @mp);
 
181
 
 
182
    return $self->{includes} = \@includes;
 
183
}
 
184
 
 
185
sub find_includes_wanted {
 
186
    my($wanted, $unwanted, @dirs) = @_;
 
187
    my @includes = ();
113
188
    for my $dir (@dirs) {
114
189
        File::Find::finddepth({
115
190
                               wanted => sub {
116
191
                                   return unless /\.h$/;
117
 
                                   return if /^($unwanted)/o;
 
192
 
 
193
                                   if ($wanted) {
 
194
                                       return unless /$wanted/;
 
195
                                   }
 
196
                                   else {
 
197
                                       return if /$unwanted/;
 
198
                                   }
 
199
 
118
200
                                   my $dir = $File::Find::dir;
119
201
                                   push @includes, "$dir/$_";
120
202
                               },
121
203
                               follow => 1,
122
204
                              }, $dir);
123
205
    }
124
 
 
125
 
    #include apr_*.h before the others
126
 
    my @wanted = grep { /apr_\w+\.h$/ } @includes;
127
 
    push @wanted, grep { !/apr_\w+\.h$/ } @includes;
128
 
 
129
 
    return $self->{includes} = \@wanted;
 
206
    return @includes;
130
207
}
131
208
 
132
209
sub generate_cscan_file {
135
212
    my $includes = $self->find_includes;
136
213
 
137
214
    my $filename = '.apache_includes';
138
 
 
139
215
    open my $fh, '>', $filename or die "can't open $filename: $!";
140
 
    for (@$includes) {
141
 
        print $fh qq(\#include "$_"\n);
 
216
 
 
217
    for my $path (@$includes) {
 
218
        my $filename = basename $path;
 
219
        print $fh qq(\#include "$path"\n);
142
220
    }
 
221
 
143
222
    close $fh;
144
223
 
145
224
    return $filename;
151
230
my %defines_wanted = (
152
231
    Apache => {
153
232
        common     => [qw{OK DECLINED DONE}],
 
233
        config     => [qw{DECLINE_CMD}],
 
234
        http       => [qw{HTTP_}],
 
235
        log        => [qw(APLOG_)],
154
236
        methods    => [qw{M_ METHODS}],
 
237
        mpmq       => [qw{AP_MPMQ_}],
155
238
        options    => [qw{OPT_}],
 
239
        override   => [qw{OR_ ACCESS_CONF RSRC_CONF}],
 
240
        platform   => [qw{CRLF CR LF}],
 
241
        remotehost => [qw{REMOTE_}],
156
242
        satisfy    => [qw{SATISFY_}],
157
 
        remotehost => [qw{REMOTE_}],
158
 
        http       => [qw{HTTP_}],
159
 
        config     => [qw{DECLINE_CMD}],
160
243
        types      => [qw{DIR_MAGIC_TYPE}],
161
 
        override   => [qw{OR_ ACCESS_CONF RSRC_CONF}],
162
 
        log        => [qw(APLOG_)],
163
 
        platform   => [qw{CRLF CR LF}],
164
244
    },
165
245
    APR => {
166
 
        table     => [qw{APR_OVERLAP_TABLES_}],
167
 
        poll      => [qw{APR_POLL}],
168
246
        common    => [qw{APR_SUCCESS}],
169
247
        error     => [qw{APR_E}],
 
248
        filemode  => ["APR_($filemode)"],
 
249
        filepath  => [qw{APR_FILEPATH_}],
170
250
        fileperms => [qw{APR_\w(READ|WRITE|EXECUTE)}],
171
251
        finfo     => [qw{APR_FINFO_}],
172
 
        filepath  => [qw{APR_FILEPATH_}],
173
 
        filemode  => ["APR_($filemode)"],
174
252
        flock     => [qw{APR_FLOCK_}],
 
253
        hook      => [qw{APR_HOOK_}],
 
254
        limit     => [qw{APR_LIMIT}],
 
255
        poll      => [qw{APR_POLL}],
175
256
        socket    => [qw{APR_SO_}],
176
 
        limit     => [qw{APR_LIMIT}],
177
 
        hook      => [qw{APR_HOOK_}],
 
257
        status    => [qw{APR_TIMEUP}],
 
258
        table     => [qw{APR_OVERLAP_TABLES_}],
178
259
        uri       => [qw{APR_URI_}],
179
260
    },
 
261
   ModPerl => {
 
262
        common    => [qw{MODPERL_RC_}],
 
263
   }
180
264
);
181
265
 
182
266
my %defines_wanted_re;
188
272
}
189
273
 
190
274
my %enums_wanted = (
191
 
    Apache => { map { $_, 1 } qw(cmd_how input_mode filter_type) },
192
 
    APR => { map { $_, 1 } qw(apr_shutdown_how apr_read_type apr_lockmech) },
 
275
    Apache => { map { $_, 1 } qw(cmd_how input_mode filter_type conn_keepalive) },
 
276
    APR => { map { $_, 1 } qw(apr_shutdown_how apr_read_type apr_lockmech apr_filetype) },
193
277
);
194
278
 
195
279
my $defines_unwanted = join '|', qw{
196
 
HTTP_VERSION APR_EOL_STR APLOG_MARK APLOG_NOERRNO
 
280
HTTP_VERSION APR_EOL_STR APLOG_MARK APLOG_NOERRNO APR_SO_TIMEOUT
197
281
};
198
282
 
199
283
sub get_constants {
286
370
        $code =~ s/\s*(\w+)\s*;\s*$//;
287
371
        $name = $1;
288
372
    }
 
373
 
289
374
    $code =~ s:/\*.*?\*/::sg;
290
375
    $code =~ s/\s*=\s*\w+//g;
291
376
    $code =~ s/^[^\{]*\{//s;
292
377
    $code =~ s/\}[^;]*;?//s;
 
378
    $code =~ s/^\s*\n//gm;
293
379
 
294
380
    while ($code =~ /\b(\w+)\b,?/g) {
295
381
        push @e, $1;
328
414
            }
329
415
        }
330
416
 
331
 
        #XXX: working around C::Scan confusion here
 
417
        #XXX: working around ModPerl::CScan confusion here
332
418
        #macro defines ap_run_error_log causes
333
419
        #cpp filename:linenumber to be included as part of the type
334
420
        for (@$args) {