import torrus 1.0.9
[freeside.git] / FS / FS / svc_cert.pm
1 package FS::svc_cert;
2
3 use strict;
4 use base qw( FS::svc_Common );
5 use Tie::IxHash;
6 #use FS::Record qw( qsearch qsearchs );
7 use FS::cust_svc;
8
9 =head1 NAME
10
11 FS::svc_cert - Object methods for svc_cert records
12
13 =head1 SYNOPSIS
14
15   use FS::svc_cert;
16
17   $record = new FS::svc_cert \%hash;
18   $record = new FS::svc_cert { 'column' => 'value' };
19
20   $error = $record->insert;
21
22   $error = $new_record->replace($old_record);
23
24   $error = $record->delete;
25
26   $error = $record->check;
27
28 =head1 DESCRIPTION
29
30 An FS::svc_cert object represents a certificate.  FS::svc_cert inherits from
31 FS::Record.  The following fields are currently supported:
32
33 =over 4
34
35 =item svcnum
36
37 primary key
38
39 =item recnum
40
41 recnum
42
43 =item privatekey
44
45 privatekey
46
47 =item csr
48
49 csr
50
51 =item certificate
52
53 certificate
54
55 =item cacert
56
57 cacert
58
59 =item common_name
60
61 common_name
62
63 =item organization
64
65 organization
66
67 =item organization_unit
68
69 organization_unit
70
71 =item city
72
73 city
74
75 =item state
76
77 state
78
79 =item country
80
81 country
82
83 =item cert_contact
84
85 contact email
86
87
88 =back
89
90 =head1 METHODS
91
92 =over 4
93
94 =item new HASHREF
95
96 Creates a new certificate.  To add the certificate to the database, see L<"insert">.
97
98 Note that this stores the hash reference, not a distinct copy of the hash it
99 points to.  You can ask the object for a copy with the I<hash> method.
100
101 =cut
102
103 # the new method can be inherited from FS::Record, if a table method is defined
104
105 sub table { 'svc_cert'; }
106
107 sub table_info {
108   my %dis = ( disable_default=>1, disable_fixed=>1, disable_inventory=>1, disable_select=>1 );
109   {
110     'name' => 'Certificate',
111     'name_plural' => 'Certificates',
112     'longname_plural' => 'Example services', #optional
113     'sorts' => 'svcnum', # optional sort field (or arrayref of sort fields, main first)
114     'display_weight' => 25,
115     'cancel_weight'  => 65,
116     'fields' => {
117       #'recnum'            => '',
118       'privatekey'        => { label=>'Private key', %dis, },
119       'csr'               => { label=>'Certificate signing request', %dis, },
120       'certificate'       => { label=>'Certificate', %dis, },
121       'cacert'            => { label=>'Certificate authority chain', %dis, },
122       'common_name'       => { label=>'Common name', %dis, },
123       'organization'      => { label=>'Organization', %dis, },
124       'organization_unit' => { label=>'Organization Unit', %dis, },
125       'city'              => { label=>'City', %dis, },
126       'state'             => { label=>'State', %dis, },
127       'country'           => { label=>'Country', %dis, },
128       'cert_contact'      => { label=>'Contact email', %dis, },
129       
130       #'another_field' => { 
131       #                     'label'     => 'Description',
132       #                     'def_label' => 'Description for service definitions',
133       #                     'type'      => 'text',
134       #                     'disable_default'   => 1, #disable switches
135       #                     'disable_fixed'     => 1, #
136       #                     'disable_inventory' => 1, #
137       #                   },
138       #'foreign_key'   => { 
139       #                     'label'        => 'Description',
140       #                     'def_label'    => 'Description for service defs',
141       #                     'type'         => 'select',
142       #                     'select_table' => 'foreign_table',
143       #                     'select_key'   => 'key_field_in_table',
144       #                     'select_label' => 'label_field_in_table',
145       #                   },
146
147     },
148   };
149 }
150
151 =item label
152
153 Returns a meaningful identifier for this example
154
155 =cut
156
157 sub label {
158   my $self = shift;
159 #  $self->label_field; #or something more complicated if necessary
160   # check privatekey, check->privatekey, more?
161   return 'Certificate';
162 }
163
164 =item insert
165
166 Adds this record to the database.  If there is an error, returns the error,
167 otherwise returns false.
168
169 =cut
170
171 # the insert method can be inherited from FS::Record
172
173 =item delete
174
175 Delete this record from the database.
176
177 =cut
178
179 # the delete method can be inherited from FS::Record
180
181 =item replace OLD_RECORD
182
183 Replaces the OLD_RECORD with this one in the database.  If there is an error,
184 returns the error, otherwise returns false.
185
186 =cut
187
188 # the replace method can be inherited from FS::Record
189
190 =item check
191
192 Checks all fields to make sure this is a valid certificate.  If there is
193 an error, returns the error, otherwise returns false.  Called by the insert
194 and replace methods.
195
196 =cut
197
198 # the check method should currently be supplied - FS::Record contains some
199 # data checking routines
200
201 sub check {
202   my $self = shift;
203
204   my $error = 
205     $self->ut_numbern('svcnum')
206     || $self->ut_numbern('recnum')
207     || $self->ut_anything('privatekey') #XXX
208     || $self->ut_anything('csr')        #XXX
209     || $self->ut_anything('certificate')#XXX
210     || $self->ut_anything('cacert')     #XXX
211     || $self->ut_textn('common_name')
212     || $self->ut_textn('organization')
213     || $self->ut_textn('organization_unit')
214     || $self->ut_textn('city')
215     || $self->ut_textn('state')
216     || $self->ut_textn('country') #XXX char(2) or NULL
217     || $self->ut_textn('cert_contact')
218   ;
219   return $error if $error;
220
221   $self->SUPER::check;
222 }
223
224 =item generate_privatekey [ KEYSIZE ]
225
226 =cut
227
228 use IPC::Run qw( run );
229 use File::Temp;
230
231 sub generate_privatekey {
232   my $self = shift;
233   my $keysize = (@_ && $_[0]) ? shift : 2048;
234   run( [qw( openssl genrsa ), $keysize], '>pipe'=>\*OUT, '2>'=>'/dev/null' )
235     or die "error running openssl: $!";
236   #XXX error checking
237   my $privatekey = join('', <OUT>);
238   $self->privatekey($privatekey);
239 }
240
241 =item check_privatekey
242
243 =cut
244
245 sub check_privatekey {
246   my $self = shift;
247   my $in = $self->privatekey;
248   run( [qw( openssl rsa -check -noout)], '<'=>\$in, '>pipe'=>\*OUT, '2>'=>'/dev/null' )
249    ;# or die "error running openssl: $!";
250
251   my $ok = <OUT>;
252   return ($ok =~ /key ok/);
253 }
254
255 tie my %subj, 'Tie::IxHash',
256   'CN' => 'common_name',
257   'O'  => 'organization',
258   'OU'  => 'organization_unit',
259   'L' => 'city',
260   'ST' => 'state',
261   'C' => 'country',
262 ;
263
264 sub subj_col {
265   \%subj;
266 }
267
268 sub subj {
269   my $self = shift;
270
271   '/'. join('/', map { my $v = $self->get($subj{$_});
272                        $v =~ s/([=\/])/\\$1/;
273                        "$_=$v";
274                      }
275                      keys %subj
276            );
277 }
278
279 sub _file {
280   my $self = shift;
281   my $field = shift;
282   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; #XXX actual cache dir
283   my $fh = new File::Temp(
284     TEMPLATE => 'cert.'. '.XXXXXXXX',
285     DIR      => $dir,
286   ) or die "can't open temp file: $!\n";
287   print $fh $self->$field;
288   close $fh;
289   $fh;
290 }
291
292 sub generate_csr {
293   my $self = shift;
294
295   my $fh = $self->_file('privatekey');
296
297   run( [qw( openssl req -new -key ), $fh->filename, '-subj', $self->subj ],
298        '>pipe'=>\*OUT, '2>'=>'/dev/null'
299      ) 
300     or die "error running openssl: $!";
301   #XXX error checking
302   my $csr = join('', <OUT>);
303   $self->csr($csr);
304 }
305
306 sub check_csr {
307   my $self = shift;
308
309   my $in = $self->csr;
310
311   run( [qw( openssl req -subject -noout ), ],
312        '<'=>\$in,
313        '>pipe'=>\*OUT, '2>'=>'/dev/null'
314      ) 
315     ;#or die "error running openssl: $!";
316
317    #subject=/CN=cn.example.com/ST=AK/O=Tofuy/OU=Soybean dept./C=US/L=Tofutown
318    my $line = <OUT>;
319    $line =~ /^subject=\/(.*)$/ or return ();
320    my $subj = $1;
321
322    map { if ( /^\s*(\w+)=\s*(.*)\s*$/ ) {
323            ($1=>$2);
324          } else {
325            ();
326          }
327        }
328        split('/', $subj);
329 }
330
331 sub generate_selfsigned {
332   my $self = shift;
333
334   my $days = 730;
335
336   my $key = $self->_file('privatekey');
337   my $csr = $self->_file('csr');
338
339   run( [qw( openssl req -x509 -nodes ),
340               '-days' => $days,
341               '-key'  => $key->filename,
342               '-in'   => $csr->filename,
343        ],
344        '>pipe'=>\*OUT, '2>'=>'/dev/null'
345      ) 
346     or die "error running openssl: $!";
347   #XXX error checking
348   my $certificate = join('', <OUT>);
349   $self->certificate($certificate);
350 }
351
352 #openssl x509 -in cert -noout -subject -issuer -dates -serial
353 #subject= /CN=cn.example.com/ST=AK/O=Tofuy/OU=Soybean dept./C=US/L=Tofutown
354 #issuer= /CN=cn.example.com/ST=AK/O=Tofuy/OU=Soybean dept./C=US/L=Tofutown
355 #notBefore=Nov  7 05:07:42 2010 GMT
356 #notAfter=Nov  6 05:07:42 2012 GMT
357 #serial=B1DBF1A799EF207B
358
359 sub check_certificate { shift->check_x509('certificate'); }
360 sub check_cacert      { shift->check_x509('cacert');      }
361
362 sub check_x509 {
363   my( $self, $field ) = ( shift, shift );
364
365   my $in = $self->$field;
366   run( [qw( openssl x509 -noout -subject -issuer -dates -serial )],
367        '<'=>\$in,
368        '>pipe'=>\*OUT, '2>'=>'/dev/null'
369      ) 
370     or die "error running openssl: $!";
371   #XXX error checking
372
373   my %hash = ();
374   while (<OUT>) {
375     /^\s*(\w+)=\s*(.*)\s*$/ or next;
376     $hash{$1} = $2;
377   }
378
379   for my $f (qw( subject issuer )) {
380
381     $hash{$f} = { map { if ( /^\s*(\w+)=\s*(.*)\s*$/ ) {
382                           ($1=>$2);
383                         } else {
384                           ();
385                         }
386                       }
387                       split('/', $hash{$f})
388                 };
389
390   }
391
392   $hash{'selfsigned'} = 1 if $hash{'subject'}->{'O'} eq $hash{'issuer'}->{'O'};
393
394   %hash;
395 }
396
397 =back
398
399 =head1 BUGS
400
401 =head1 SEE ALSO
402
403 L<FS::Record>, schema.html from the base documentation.
404
405 =cut
406
407 1;
408