1 /* Licensed to the Apache Software Foundation (ASF) under one or more
2  * contributor license agreements.  See the NOTICE file distributed with
3  * this work for additional information regarding copyright ownership.
4  * The ASF licenses this file to You under the Apache License, Version 2.0
5  * (the "License"); you may not use this file except in compliance with
6  * the License.  You may obtain a copy of the License at
7  *
8  *     http://www.apache.org/licenses/LICENSE-2.0
9  *
10  * Unless required by applicable law or agreed to in writing, software
11  * distributed under the License is distributed on an "AS IS" BASIS,
12  * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13  * See the License for the specific language governing permissions and
14  * limitations under the License.
15  */
16 
mpxs_Apache2__Log_BOOT(pTHX)17 static void mpxs_Apache2__Log_BOOT(pTHX)
18 {
19     av_push(get_av("Apache2::Log::Request::ISA", TRUE),
20             newSVpv("Apache2::Log", 12));
21     av_push(get_av("Apache2::Log::Server::ISA", TRUE),
22             newSVpv("Apache2::Log", 12));
23 }
24 
25 #define croak_inval_obj()                                       \
26     Perl_croak(aTHX_ "Argument is not an Apache2::RequestRec "   \
27                "or Apache2::ServerRec object")
28 
mpxs_ap_log_error(pTHX_ int level,SV * sv,SV * msg)29 static void mpxs_ap_log_error(pTHX_ int level, SV *sv, SV *msg)
30 {
31     char *file = NULL;
32     int line = 0;
33     char *str;
34     SV *svstr = (SV *)NULL;
35     STRLEN n_a;
36     int lmask = level & APLOG_LEVELMASK;
37     server_rec *s;
38     request_rec *r = NULL;
39 
40     if (SvROK(sv) && sv_isa(sv, "Apache2::Log::Request")) {
41         r = INT2PTR(request_rec *, SvObjIV(sv));
42         s = r->server;
43     }
44     else if (SvROK(sv) && sv_isa(sv, "Apache2::Log::Server")) {
45         s = INT2PTR(server_rec *, SvObjIV(sv));
46     }
47     else {
48         s = modperl_global_get_server_rec();
49     }
50 
51     if ((lmask >= APLOG_DEBUG) && (mp_loglevel(s) >= APLOG_DEBUG)) {
52         COP *cop = PL_curcop;
53         file = CopFILE(cop); /* (caller)[1] */
54         line = CopLINE(cop); /* (caller)[2] */
55     }
56 
57     if ((mp_loglevel(s) >= lmask) &&
58         SvROK(msg) && (SvTYPE(SvRV(msg)) == SVt_PVCV)) {
59         dSP;
60         ENTER;SAVETMPS;
61         PUSHMARK(sp);
62         (void)call_sv(msg, G_SCALAR);
63         SPAGAIN;
64         svstr = POPs;
65         (void)SvREFCNT_inc(svstr);
66         PUTBACK;
67         FREETMPS;LEAVE;
68         str = SvPV(svstr,n_a);
69     }
70     else {
71         str = SvPV(msg,n_a);
72     }
73 
74     if (r) {
75         ap_log_rerror(file, line, mp_module_index_ level, 0, r,
76 		      "%s", str);
77     }
78     else {
79         ap_log_error(file, line, mp_module_index_ level, 0, s,
80 		     "%s", str);
81     }
82 
83     if (svstr) {
84         SvREFCNT_dec(svstr);
85     }
86 }
87 
88 #define MP_LOG_REQUEST 1
89 #define MP_LOG_SERVER  2
90 
mpxs_Apache2__Log_log(pTHX_ SV * sv,int logtype)91 static SV *mpxs_Apache2__Log_log(pTHX_ SV *sv, int logtype)
92 {
93     SV *svretval;
94     void *retval;
95     char *pclass;
96 
97     switch (logtype) {
98       case MP_LOG_REQUEST:
99         pclass = "Apache2::Log::Request";
100         retval = (void *)modperl_sv2request_rec(aTHX_ sv);
101         break;
102       case MP_LOG_SERVER:
103         pclass = "Apache2::Log::Server";
104         retval = (void *)modperl_sv2server_rec(aTHX_ sv);
105         break;
106       default:
107         croak_inval_obj();
108     };
109 
110     svretval = newSV(0);
111     sv_setref_pv(svretval, pclass, (void*)retval);
112 
113     return svretval;
114 }
115 
116 #define mpxs_Apache2__RequestRec_log(sv)                 \
117     mpxs_Apache2__Log_log(aTHX_ sv, MP_LOG_REQUEST)
118 
119 #define mpxs_Apache2__ServerRec_log(sv)                  \
120     mpxs_Apache2__Log_log(aTHX_ sv, MP_LOG_SERVER)
121 
modperl_perl_do_join(pTHX_ SV ** mark,SV ** sp)122 static MP_INLINE SV *modperl_perl_do_join(pTHX_ SV **mark, SV **sp)
123 {
124     SV *sv = newSV(0);
125     SV *delim;
126 #ifdef WIN32
127     /* XXX: using PL_sv_no crashes on win32 with 5.6.1 */
128     delim = newSVpv("", 0);
129 #else
130     delim = SvREFCNT_inc(&PL_sv_no);
131 #endif
132 
133     do_join(sv, delim, mark, sp);
134 
135     SvREFCNT_dec(delim);
136 
137     return sv;
138 }
139 
140 #define my_do_join(m, s)                        \
141     modperl_perl_do_join(aTHX_ (m), (s))
142 
XS(MPXS_Apache2__Log_dispatch)143 MP_STATIC XS(MPXS_Apache2__Log_dispatch)
144 {
145     dXSARGS;
146     SV *msgsv;
147     int level;
148     char *name = GvNAME(CvGV(cv));
149 
150     if (items < 2) {
151         Perl_croak(aTHX_ "usage: %s::%s(obj, ...)",
152                    mpxs_cv_name());
153     }
154 
155     if (items > 2) {
156         msgsv = my_do_join(MARK+1, SP);
157     }
158     else {
159         msgsv = ST(1);
160         (void)SvREFCNT_inc(msgsv);
161     }
162 
163     switch (*name) {
164       case 'e':
165         if (*(name + 1) == 'r') {
166             level = APLOG_ERR;
167             break;
168         }
169         level = APLOG_EMERG;
170         break;
171       case 'w':
172         level = APLOG_WARNING;
173         break;
174       case 'n':
175         level = APLOG_NOTICE;
176         break;
177       case 'i':
178         level = APLOG_INFO;
179         break;
180       case 'd':
181         level = APLOG_DEBUG;
182         break;
183       case 'a':
184         level = APLOG_ALERT;
185         break;
186       case 'c':
187         level = APLOG_CRIT;
188         break;
189       default:
190         level = APLOG_ERR; /* should never get here */
191         break;
192     };
193 
194     mpxs_ap_log_error(aTHX_ level, ST(0), msgsv);
195 
196     SvREFCNT_dec(msgsv);
197 
198     XSRETURN_EMPTY;
199 }
200 
XS(MPXS_Apache2__Log_LOG_MARK)201 MP_STATIC XS(MPXS_Apache2__Log_LOG_MARK)
202 {
203     dXSARGS;
204     ax = ax; /* -Wall */;
205 
206     mpxs_PPCODE({
207         COP *cop = PL_curcop;
208 
209         if (items) {
210             Perl_croak(aTHX_ "usage %s::%s()", mpxs_cv_name());
211         }
212 
213         EXTEND(SP, 2);
214         PUSHs_mortal_pv(CopFILE(cop));
215         PUSHs_mortal_iv(CopLINE(cop));
216     });
217 }
218 
XS(MPXS_Apache2__Log_log_xerror)219 MP_STATIC XS(MPXS_Apache2__Log_log_xerror)
220 {
221     dXSARGS;
222     SV *msgsv = (SV *)NULL;
223     STRLEN n_a;
224     request_rec *r = NULL;
225     server_rec *s = NULL;
226     char *msgstr;
227     const char *file;
228     int line, level;
229     apr_status_t status;
230 
231     if (items < 6) {
232         Perl_croak(aTHX_ "usage %s::%s(file, line, level, status, ...)",
233                    mpxs_cv_name());
234     }
235 
236     switch (*(GvNAME(CvGV(cv)) + 4)) { /* 4 == log_ */
237       case 'r':
238         r = modperl_xs_sv2request_rec(aTHX_ ST(0), NULL, cv);
239         break;
240       case 's':
241         s = modperl_sv2server_rec(aTHX_ ST(0));
242         break;
243       default:
244         croak_inval_obj();
245     };
246 
247     file   = (const char *)SvPV(ST(1), n_a);
248     line   = (int)SvIV(ST(2));
249     level  = (int)SvIV(ST(3));
250     status = (apr_status_t)SvIV(ST(4));
251 
252     if (items > 6) {
253         msgsv = my_do_join(MARK+5, SP);
254     }
255     else {
256         msgsv = ST(5);
257         (void)SvREFCNT_inc(msgsv);
258     }
259 
260     msgstr = SvPV(msgsv, n_a);
261 
262     if (r) {
263         ap_log_rerror(file, line, mp_module_index_ level, status, r,
264 		      "%s", msgstr);
265     }
266     else {
267         ap_log_error(file, line, mp_module_index_ level, status, s,
268 		     "%s", msgstr);
269     }
270 
271     SvREFCNT_dec(msgsv);
272 
273     XSRETURN_EMPTY;
274 }
275 
276 /*
277  * this function handles:
278  * $r->log_error
279  * $s->log_error
280  * $r->warn
281  * $s->warn
282  * Apache2::ServerRec::warn
283  */
XS(MPXS_Apache2__Log_log_error)284 MP_STATIC XS(MPXS_Apache2__Log_log_error)
285 {
286     dXSARGS;
287     request_rec *r = NULL;
288     server_rec *s = NULL;
289     int i = 0;
290     char *errstr = NULL;
291     SV *sv = (SV *)NULL;
292     STRLEN n_a;
293 
294     if (items > 1) {
295         if (sv_isa(ST(0), "Apache2::ServerRec")) {
296             s = INT2PTR(server_rec *, SvObjIV(ST(0)));
297         }
298         else if ((r = modperl_xs_sv2request_rec(aTHX_ ST(0),
299                                                 "Apache2::RequestRec", cv))) {
300             s = r->server;
301         }
302     }
303 
304     if (s) {
305         i = 1;
306     }
307     else {
308         request_rec *r = NULL;
309         (void)modperl_tls_get_request_rec(&r);
310         if (r) {
311             s = r->server;
312         }
313         else {
314             s = modperl_global_get_server_rec();
315         }
316     }
317 
318     if (items > 1+i) {
319         sv = my_do_join(MARK+i, SP); /* $sv = join '', @_[1..$#_] */
320         errstr = SvPV(sv,n_a);
321     }
322     else {
323         errstr = SvPV(ST(i),n_a);
324     }
325 
326     switch (*GvNAME(CvGV(cv))) {
327       case 'w':
328         modperl_log_warn(s, errstr);
329         break;
330       default:
331         modperl_log_error(s, errstr);
332         break;
333     }
334 
335     if (sv) {
336         SvREFCNT_dec(sv);
337     }
338 
339     XSRETURN_EMPTY;
340 }
341 
342 /*
343  * Local Variables:
344  * c-basic-offset: 4
345  * indent-tabs-mode: nil
346  * End:
347  */
348