~rdoering/ubuntu/karmic/erlang/fix-535090

« back to all changes in this revision

Viewing changes to erts/emulator/beam/packet_parser.h

  • Committer: Bazaar Package Importer
  • Author(s): Sergei Golovan
  • Date: 2009-02-15 16:42:52 UTC
  • mfrom: (3.1.2 squeeze)
  • Revision ID: james.westby@ubuntu.com-20090215164252-q5x4rcf8a5pbesb1
Tags: 1:12.b.5-dfsg-2
Upload to unstable after lenny is released.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/* ``The contents of this file are subject to the Erlang Public License,
 
2
 * Version 1.1, (the "License"); you may not use this file except in
 
3
 * compliance with the License. You should have received a copy of the
 
4
 * Erlang Public License along with this software. If not, it can be
 
5
 * retrieved via the world wide web at http://www.erlang.org/.
 
6
 * 
 
7
 * Software distributed under the License is distributed on an "AS IS"
 
8
 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 
9
 * the License for the specific language governing rights and limitations
 
10
 * under the License.
 
11
 * 
 
12
 * The Initial Developer of the Original Code is Ericsson Utvecklings AB.
 
13
 * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
 
14
 * AB. All Rights Reserved.''
 
15
 * 
 
16
 *     $Id$
 
17
 */
 
18
/* A protocol decoder. Simple packet length extraction as well as packet
 
19
 * body parsing with protocol specific callback interfaces (http and ssl).
 
20
 */
 
21
#ifndef __PACKET_PARSER_H__
 
22
#define __PACKET_PARSER_H__
 
23
 
 
24
#include <erl_driver.h>
 
25
#include "sys.h"
 
26
 
 
27
 
 
28
/* INET_LOPT_PACKET options */
 
29
enum PacketParseType {
 
30
    TCP_PB_RAW      = 0,
 
31
    TCP_PB_1        = 1,
 
32
    TCP_PB_2        = 2,
 
33
    TCP_PB_4        = 3,
 
34
    TCP_PB_ASN1     = 4,
 
35
    TCP_PB_RM       = 5,
 
36
    TCP_PB_CDR      = 6,
 
37
    TCP_PB_FCGI     = 7,
 
38
    TCP_PB_LINE_LF  = 8,
 
39
    TCP_PB_TPKT     = 9,
 
40
    TCP_PB_HTTP     = 10,
 
41
    TCP_PB_HTTPH    = 11,
 
42
    TCP_PB_SSL_TLS  = 12
 
43
};
 
44
 
 
45
typedef struct http_atom {
 
46
    struct http_atom* next;   /* next in bucket */
 
47
    unsigned long h;          /* stored hash value */
 
48
    const char* name;
 
49
    int   len;
 
50
    int index;                /* index in table + bit-pos */
 
51
    ErlDrvTermData atom;      /* erlang atom rep */
 
52
} http_atom_t;  
 
53
 
 
54
typedef struct {
 
55
    enum {
 
56
        URI_STAR,    /* '*' */
 
57
        URI_STRING,  /* "string(s1)" */
 
58
        URI_ABS_PATH,/* {abs_path, "path(s1)"} */
 
59
        URI_SCHEME,  /* {scheme, "scheme(s1)", "string(s2)"} */
 
60
        URI_HTTP,    /* {absoluteURI, http, "host(s1)", Port, "path(s2)"} */
 
61
        URI_HTTPS    /* {absoluteURI, https, ... */
 
62
    } type;
 
63
    const char* s1_ptr;
 
64
    int s1_len;
 
65
    const char* s2_ptr;
 
66
    int s2_len;
 
67
    int port; /* 0=undefined */
 
68
}PacketHttpURI;
 
69
 
 
70
typedef int HttpResponseMessageFn(void* arg, int major, int minor, int status,
 
71
                                  const char* phrase, int phrase_len);
 
72
typedef int HttpRequestMessageFn(void* arg, const http_atom_t* meth, const char* meth_ptr,
 
73
                                 int meth_len, const PacketHttpURI*, int major, int minor);
 
74
typedef int HttpEohMessageFn(void *arg);
 
75
typedef int HttpHeaderMessageFn(void* arg, const http_atom_t* name, const char* name_ptr,
 
76
                                int name_len, const char* value_ptr, int value_len);
 
77
typedef int HttpErrorMessageFn(void* arg, const char* buf, int len);
 
78
typedef int SslTlsFn(void* arg, unsigned type, unsigned major, unsigned minor,
 
79
                     const char* data, int len, const char* prefix, int plen);
 
80
 
 
81
typedef struct {
 
82
    HttpResponseMessageFn* http_response;
 
83
    HttpRequestMessageFn* http_request;
 
84
    HttpEohMessageFn* http_eoh;
 
85
    HttpHeaderMessageFn* http_header;
 
86
    HttpErrorMessageFn* http_error;
 
87
    SslTlsFn* ssl_tls;
 
88
}PacketCallbacks;
 
89
 
 
90
 
 
91
/* Called once at emulator start
 
92
 */
 
93
void packet_parser_init(void);
 
94
 
 
95
/* Returns > 0 Total packet length.
 
96
 *         = 0 Length unknown, need more data.
 
97
 *         < 0 Error, invalid format.
 
98
 */
 
99
int packet_get_length(enum PacketParseType htype,
 
100
                      const char* ptr, unsigned n,  /* Bytes read so far */
 
101
                      unsigned max_plen,      /* Packet max length, 0=no limit */
 
102
                      unsigned trunc_len,     /* Truncate (lines) if longer, 0=no limit */
 
103
                      int* statep);           /* Internal protocol state */
 
104
 
 
105
ERTS_GLB_INLINE
 
106
void packet_get_body(enum PacketParseType htype,
 
107
                     const char** bufp, /* In: Packet header, Out: Packet body */
 
108
                     int* lenp);        /* In: Packet length, Out: Body length */
 
109
 
 
110
/* Returns 1 = Packet parsed and handled by callbacks.
 
111
**         0 = No parsing support for this packet type
 
112
**        -1 = Error
 
113
*/
 
114
ERTS_GLB_INLINE
 
115
int packet_parse(enum PacketParseType htype, 
 
116
                 const char* buf, int len, /* Total packet */
 
117
                 int* statep, PacketCallbacks* pcb, void* arg);
 
118
 
 
119
 
 
120
 
 
121
/* Internals for the inlines below: */
 
122
 
 
123
#define FCGI_VERSION_1 1
 
124
struct fcgi_head {
 
125
    unsigned char version;
 
126
    unsigned char type;
 
127
    unsigned char requestIdB1;
 
128
    unsigned char requestIdB0;
 
129
    unsigned char contentLengthB1;
 
130
    unsigned char contentLengthB0;
 
131
    unsigned char paddingLength;
 
132
    unsigned char reserved;
 
133
    /* char data[] */
 
134
    /* char padding[paddingLength] */
 
135
};
 
136
int packet_parse_http(const char*, int, int*, PacketCallbacks*, void*);
 
137
int packet_parse_ssl(const char*, int, PacketCallbacks*, void*);
 
138
 
 
139
 
 
140
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
 
141
ERTS_GLB_INLINE
 
142
void packet_get_body(enum PacketParseType htype, const char** bufp, int* lenp)
 
143
{
 
144
    switch (htype) {
 
145
    case TCP_PB_1:  *bufp += 1; *lenp -= 1; break;
 
146
    case TCP_PB_2:  *bufp += 2; *lenp -= 2; break;
 
147
    case TCP_PB_4:  *bufp += 4; *lenp -= 4; break;
 
148
    case TCP_PB_FCGI:
 
149
        *lenp -= ((struct fcgi_head*)*bufp)->paddingLength;
 
150
        break;
 
151
    default:
 
152
        ;/* Return other packets "as is" */
 
153
    }
 
154
}
 
155
 
 
156
ERTS_GLB_INLINE
 
157
int packet_parse(enum PacketParseType htype, const char* buf, int len,
 
158
                 int* statep, PacketCallbacks* pcb, void* arg)
 
159
{       
 
160
    switch (htype) {
 
161
    case TCP_PB_HTTP:
 
162
    case TCP_PB_HTTPH:
 
163
        if (packet_parse_http(buf, len, statep, pcb, arg) < 0)
 
164
            pcb->http_error(arg, buf, len);
 
165
        return 1;
 
166
    case TCP_PB_SSL_TLS:
 
167
        return packet_parse_ssl(buf, len, pcb, arg);
 
168
    default:;
 
169
    }
 
170
    return 0;
 
171
}
 
172
#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
 
173
 
 
174
#endif /* !__PACKET_PARSER_H__ */
 
175