File Coverage

blib/lib/Lemonldap/NG/Manager/Cli.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package Lemonldap::NG::Manager::Cli;
2              
3             # Required packages
4              
5 1     1   873 use strict;
  1         2  
  1         37  
6 1     1   472 use Lemonldap::NG::Common::Conf;
  0            
  0            
7             use Lemonldap::NG::Common::Conf::SubAttributes;
8             use POSIX qw(strftime);
9              
10             # Constants
11              
12             our $VERSION = "1.4.0";
13              
14             my $ERRORS = {
15             TOO_FEW_ARGUMENTS => "Too few arguments",
16             UNKNOWN_ACTION => "Unknown action",
17             CONFIG_WRITE_ERROR => "Error while writting the configuration",
18             CONFIG_READ_ERROR => "Error while reading the configuration",
19             };
20              
21             ## @cmethod Lemonldap::NG::Manager::Cli new ()
22             # Create a new Lemonldap::NG::Manager::Cli object
23             #
24             # @return New Lemonldap::NG::Manager::Cli object
25             sub new {
26             my ($class) = @_;
27              
28             my $self = {
29             "confAccess" => Lemonldap::NG::Common::Conf->new(),
30             "subAttributes" => Lemonldap::NG::Common::Conf::SubAttributes->new(),
31             };
32              
33             $self->{conf} = $self->{confAccess}->getConf();
34              
35             bless( $self, $class );
36             return $self;
37             }
38              
39             ## @method int saveConf ()
40             # Save LemonLDAP::NG configuration
41             #
42             # @return Configuration identifier
43             sub saveConf {
44             my ($self) = @_;
45              
46             $self->{conf}->{cfgAuthor} = "LemonLDAP::NG CLI";
47             $self->{conf}->{cfgAuthorIP} = "127.0.0.1";
48             $self->{conf}->{cfgDate} = time();
49              
50             my $ret = $self->{confAccess}->saveConf( $self->{conf} );
51             return $ret;
52             }
53              
54             ## @method int increment ()
55             # Force increment of configuration number
56             #
57             # @return nothing
58             sub increment {
59             my ($self) = @_;
60              
61             # Update cache to save modified data
62             $self->updateCache();
63              
64             $self->{confAccess}->{cfgNumFixed} = 0;
65             $self->{confModified} = 1;
66              
67             return;
68             }
69              
70             ## @method updateCache()
71             # Update configuration cache
72             #
73             # @return nothing
74             sub updateCache {
75             my ($self) = @_;
76              
77             # Get configuration from DB (update cache)
78             my $cfgNum = $self->{conf}->{cfgNum};
79             $self->{conf} = $self->{confAccess}->getDBConf( { cfgNum => $cfgNum } );
80              
81             print "Cache updated with configuration number $cfgNum\n";
82             }
83              
84             ## @method string determineMethod ()
85             # Determine the method from the arguments
86             #
87             # @return method name
88             sub determineMethod {
89             my ( $self, $opt ) = @_;
90             $opt =~ s/-(\w+)/ucfirst($1)/ge;
91             return $opt;
92             }
93              
94             ## @method void setError (string str)
95             # Set error message
96             #
97             # @param str Text of the error
98             sub setError {
99             my ( $self, $msg ) = @_;
100             $self->{errormsg} = $msg;
101             }
102              
103             ## @method string getError ()
104             # Get error message
105             #
106             # @return Text of the error
107             sub getError {
108             my ($self) = @_;
109             return $self->{errormsg};
110             }
111              
112             ## @method int run (string method, array args)
113             # Run the requested method with @args
114             #
115             # @return result code of the method
116             sub run {
117             my $self = shift;
118             my $method = shift;
119              
120             my @args;
121             @args = @_ if ( @_ >= 1 );
122              
123             # perl black magic :)
124             return ( @args >= 1 ) ? $self->$method(@args) : $self->$method();
125             }
126              
127             ## @method void set ( string variable, string value )
128             # Set the requested variable to the given value
129             #
130             # @return nothing
131             sub set {
132             my ( $self, $var, $val ) = @_;
133             unless ( $var and $val ) {
134             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
135             return 0;
136             }
137             $self->{conf}->{$var} = $val;
138             $self->{confModified} = 1;
139             }
140              
141             ## @method void unset (string variable)
142             # Unset the requested variable
143             #
144             # @return nothing
145             sub unset {
146             my ( $self, $var ) = @_;
147             unless ($var) {
148             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
149             return 0;
150             }
151             if ( not defined( $self->{conf}->{$var} ) ) {
152             $self->setError( "$var: "
153             . $ERRORS->{CONFIG_WRITE_ERROR}
154             . ": There is no variable named $var" );
155             return 0;
156             }
157             delete $self->{conf}->{$var};
158             $self->{confModified} = 1;
159             }
160              
161             ## @method void get (string variable)
162             # Get the value of the requested variable
163             #
164             # @return nothing
165             sub get {
166             my ( $self, $var ) = @_;
167             unless ($var) {
168             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
169             return 0;
170             }
171             if ( not defined( $self->{conf}->{$var} ) ) {
172             $self->setError( "$var: "
173             . $ERRORS->{CONFIG_READ_ERROR}
174             . ": There is no variable named $var" );
175             return 0;
176             }
177              
178             if ( ref( $self->{conf}->{$var} ) ) {
179             $self->setError("$var is not a scalar parameter. Try getHash $var");
180             return 0;
181             }
182              
183             print "$var = " . $self->{conf}->{$var} . "\n";
184             }
185              
186             ## @method void setHash ( string variable, string key, string value )
187             # Set for the requested variable the key/value pair
188             #
189             # @return nothing
190             sub setHash {
191             my ( $self, $var, $key, $val ) = @_;
192             unless ( $var and $key and $val ) {
193             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
194             return 0;
195             }
196              
197             $self->{conf}->{$var}->{$key} = $val;
198             $self->{confModified} = 1;
199             }
200              
201             ## @method void unsetHash (string variable, string key)
202             # Unset the key for the requested variable
203             #
204             # @return nothing
205             sub unsetHash {
206             my ( $self, $var, $key ) = @_;
207             unless ( $var and $key ) {
208             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
209             return 0;
210             }
211             if ( not defined( $self->{conf}->{$var} ) ) {
212             $self->setError( "$var: "
213             . $ERRORS->{CONFIG_WRITE_ERROR}
214             . ": There is no variable named $var" );
215             return 0;
216             }
217             if ( not defined( $self->{conf}->{$var}->{$key} ) ) {
218             $self->setError( "$var: "
219             . $ERRORS->{CONFIG_WRITE_ERROR}
220             . ": There is no key $key for variable $var" );
221             return 0;
222             }
223              
224             delete $self->{conf}->{$var}->{$key};
225             $self->{confModified} = 1;
226             }
227              
228             ## @method void getHash (string variable)
229             # Get all key/value pair of the requested variable
230             #
231             # @return nothing
232             sub getHash {
233             my ( $self, $var ) = @_;
234             unless ($var) {
235             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
236             return 0;
237             }
238             if ( not defined( $self->{conf}->{$var} ) ) {
239             $self->setError( "$var: "
240             . $ERRORS->{CONFIG_READ_ERROR}
241             . ": There is no variable named $var" );
242             return 0;
243             }
244              
245             unless ( ref( $self->{conf}->{$var} ) eq "HASH" ) {
246             $self->setError("$var is not a Hash parameter. Try get $var.");
247             return 0;
248             }
249              
250             use Data::Dumper;
251             print Dumper( $self->{conf}->{$var} ) . "\n";
252             }
253              
254             ## @method void setMacro (string macro, string value)
255             # Set the requested macro to the given value
256             #
257             # @return nothing
258             sub setMacro {
259             my ( $self, $macro, $value ) = @_;
260             unless ( $macro and $value ) {
261             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
262             return 0;
263             }
264             $self->{conf}->{macros}->{$macro} = $value;
265             $self->{confModified} = 1;
266             }
267              
268             ## @method void unsetMacro (string macro)
269             # Unset the requested macro
270             #
271             # return nothing
272             sub unsetMacro {
273             my ( $self, $macro ) = @_;
274             unless ($macro) {
275             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
276             return 0;
277             }
278             if ( not defined( $self->{conf}->{macros}->{$macro} ) ) {
279             $self->setError( "$macro: "
280             . $ERRORS->{CONFIG_WRITE_ERROR}
281             . ": There is no macro named $macro" );
282             return 0;
283             }
284             delete $self->{conf}->{macros}->{$macro};
285             $self->{confModified} = 1;
286             }
287              
288             ## @method void getMacro (string macro)
289             # Get the value of the requested macro
290             #
291             # @return nothing
292             sub getMacro {
293             my ( $self, $macro ) = @_;
294             unless ($macro) {
295             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
296             return 0;
297             }
298             if ( not defined( $self->{conf}->{macros}->{$macro} ) ) {
299             $self->setError( "$macro: "
300             . $ERRORS->{CONFIG_WRITE_ERROR}
301             . ": There is no macro named $macro" );
302             return 0;
303             }
304             print "$macro = " . $self->{conf}->{macros}->{$macro} . "\n";
305             }
306              
307             ## @method void appsSetCat ( int id, string name )
308             # Set the category name by its id
309             #
310             # @return nothing
311             sub appsSetCat {
312             my ( $self, $id, $name ) = @_;
313             unless ( $id and $name ) {
314             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
315             return 0;
316             }
317             if ( defined( $self->{conf}->{applicationList}->{$id} ) ) {
318             $self->{conf}->{applicationList}->{$id}->{catname} = $name;
319             }
320             else {
321             $self->{conf}->{applicationList}->{$id} = {
322             type => "category",
323             name => $name
324             };
325             }
326             $self->{confModified} = 1;
327             }
328              
329             ## @method void appsGetCat ( int id )
330             # Get a category name by its id
331             #
332             # @return nothing
333             sub appsGetCat {
334             my ( $self, $id ) = @_;
335             unless ($id) {
336             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
337             return 0;
338             }
339             if ( not defined( $self->{conf}->{applicationList}->{$id} ) ) {
340             $self->setError("$_: There is no category $id");
341             return 0;
342             }
343             print "$id : " . $self->{conf}->{applicationList}->{$id}->{catname} . "\n";
344             }
345              
346             ## @method void appsAdd (int appId, int catId )
347             # Add a new application to a category
348             #
349             # @return nothing
350             sub appsAdd {
351             my ( $self, $appId, $catId ) = @_;
352             unless ( $appId and $catId ) {
353             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
354             return 0;
355             }
356             if ( not defined( $self->{conf}->{applicationList}->{$catId} ) ) {
357             $self->setError( "$catId"
358             . $ERRORS->{CONFIG_WRITE_ERROR}
359             . ": Category $catId doesn't exist" );
360             return 0;
361             }
362             if ( defined( $self->{conf}->{applicationList}->{$catId}->{$appId} ) ) {
363             $self->setError( "$catId"
364             . $ERRORS->{CONFIG_WRITE_ERROR}
365             . ": Application $appId exists" );
366             }
367             $self->{conf}->{applicationList}->{$catId}->{$appId} = {
368             type => "application",
369             options => {
370             logo => "demo.png",
371             name => $appId,
372             description => $appId,
373             display => "auto",
374             uri => "http://test1.example.com"
375             }
376             };
377             $self->{confModified} = 1;
378             }
379              
380             ## @cmethod void appsSetUri ( string id, string uri )
381             # Set given application's uri
382             #
383             # @return nothing
384             sub appsSetUri {
385             my ( $self, $id, $uri ) = @_;
386             unless ( $id and $uri ) {
387             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
388             return 0;
389             }
390             my $found = 0;
391              
392             while ( my ( $catId, $appList ) = each %{ $self->{conf}->{applicationList} }
393             and $found != 1 )
394             {
395             while ( my ( $_appid, $app ) = each %{$appList} and $found != 1 ) {
396             if ( $id eq $_appid ) {
397             $app->{options}->{uri} = $uri;
398             $found = 1;
399             $self->{confModified} = 1;
400             }
401             }
402             }
403              
404             if ( $found == 0 ) {
405             $self->setError( "$id: "
406             . $ERRORS->{CONFIG_WRITE_ERROR}
407             . ": Application $id not found" );
408             return 0;
409             }
410             }
411              
412             ## @method void appsSetName ( string id, string name )
413             # Set the name of the given application
414             #
415             # @return nothing
416             sub appsSetName {
417             my ( $self, $id, $name ) = @_;
418             unless ( $id and $name ) {
419             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
420             return 0;
421             }
422             my $found = 0;
423              
424             while ( my ( $catId, $appList ) = each %{ $self->{conf}->{applicationList} }
425             and $found != 1 )
426             {
427             while ( my ( $_appid, $app ) = each %{$appList} and $found != 1 ) {
428             if ( $id eq $_appid ) {
429             $app->{options}->{name} = $name;
430             $found = 1;
431             $self->{confModified} = 1;
432             }
433             }
434             }
435             if ( $found == 0 ) {
436             $self->setError( "$id: "
437             . $ERRORS->{CONFIG_WRITE_ERROR}
438             . ": Application $id not found" );
439             return 0;
440             }
441             }
442              
443             ## @method void appsSetDesc ( string id, string desc )
444             # Set the description of the given application
445             #
446             # @return nothing
447             sub appsSetDesc {
448             my ( $self, $id, $desc ) = @_;
449             unless ( $id and $desc ) {
450             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
451             return 0;
452             }
453             my $found = 0;
454              
455             while ( my ( $catId, $appList ) = each %{ $self->{conf}->{applicationList} }
456             and $found != 1 )
457             {
458             while ( my ( $_appid, $app ) = each %{$appList} and $found != 1 ) {
459             if ( $id eq $_appid ) {
460             $app->{options}->{description} = $desc;
461             $found = 1;
462             $self->{confModified} = 1;
463             }
464             }
465             }
466             if ( $found == 0 ) {
467             $self->setError( "$id: "
468             . $ERRORS->{CONFIG_WRITE_ERROR}
469             . ": Application $id not found" );
470             return 0;
471             }
472             }
473              
474             ## @method void appsSetLogo ( string id, string logo )
475             # Set the logo of the given application
476             #
477             # @return nothing
478             sub appsSetLogo {
479             my ( $self, $id, $logo ) = @_;
480             unless ( $id and $logo ) {
481             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
482             return 0;
483             }
484             my $found = 0;
485              
486             while ( my ( $catId, $appList ) = each %{ $self->{conf}->{applicationList} }
487             and $found != 1 )
488             {
489             while ( my ( $_appid, $app ) = each %{$appList} and $found != 1 ) {
490             if ( $id eq $_appid ) {
491             $app->{options}->{logo} = $logo;
492             $found = 1;
493             $self->{confModified} = 1;
494             }
495             }
496             }
497             if ( $found == 0 ) {
498             $self->setError( "$id: "
499             . $ERRORS->{CONFIG_WRITE_ERROR}
500             . ": Application $id not found" );
501             return 0;
502             }
503             }
504              
505             ## @method void appsSetDisplay ( string id, string display )
506             # Set display setting of the given application
507             #
508             # @return nothing
509             sub appsSetDisplay {
510             my ( $self, $id, $display ) = @_;
511             unless ( $id and $display ) {
512             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
513             return 0;
514             }
515             my $found = 0;
516              
517             while ( my ( $catId, $appList ) = each %{ $self->{conf}->{applicationList} }
518             and $found != 1 )
519             {
520             while ( my ( $_appid, $app ) = each %{$appList} and $found != 1 ) {
521             if ( $id eq $_appid ) {
522             $app->{options}->{display} = $display;
523             $found = 1;
524             $self->{confModified} = 1;
525             }
526             }
527             }
528              
529             if ( $found == 0 ) {
530             $self->setError( "$id: "
531             . $ERRORS->{CONFIG_WRITE_ERROR}
532             . ": Application $id not found" );
533             return 0;
534             }
535              
536             }
537              
538             ## @method void appsGet ( string id )
539             # Show all the given application's settings
540             #
541             # @return nothing
542             sub appsGet {
543             my ( $self, $id ) = @_;
544             unless ($id) {
545             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
546             return 0;
547             }
548             my $found = 0;
549              
550             while ( my ( $catid, $applist ) = each %{ $self->{conf}->{applicationList} }
551             and $found != 1 )
552             {
553             while ( my ( $_appid, $app ) = each %{$applist} and $found != 1 ) {
554             if ( $id eq $_appid ) {
555             print "Category $catid: "
556             . $self->{conf}->{applicationList}->{$catid}->{catname}
557             . "\n";
558             print "Application $id: " . $app->{options}->{name} . "\n";
559             print "- Description: " . $app->{options}->{description} . "\n";
560             print "- URI: " . $app->{options}->{uri} . "\n";
561             print "- Logo: " . $app->{options}->{logo} . "\n";
562             print "- Display: " . $app->{options}->{display} . "\n";
563             $found = 1;
564             }
565             }
566             }
567              
568             if ( $found == 0 ) {
569             $self->setError("Application $id not found");
570             return 0;
571             }
572             }
573              
574             ## @method void appsRm ( string id )
575             # Delete the given application from the configuration
576             #
577             # @return nothing
578             sub appsRm {
579             my ( $self, $id ) = @_;
580             unless ($id) {
581             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
582             return 0;
583             }
584             my $found = 0;
585              
586             while ( my ( $catid, $applist ) = each %{ $self->{conf}->{applicationList} }
587             and $found != 1 )
588             {
589             while ( my ( $_appid, $app ) = each %{$applist} and $found != 1 ) {
590             if ( $id eq $_appid ) {
591             delete $applist->{$id};
592             $found = 1;
593             $self->{confModified} = 1;
594             }
595             }
596             }
597             if ( $found == 0 ) {
598             $self->setError("Application $id not found");
599             return 0;
600             }
601             }
602              
603             ## @method void rulesSet ( string uri, string expr, string rule )
604             # Set a rule for the given vhost
605             #
606             # @return nothing
607             sub rulesSet {
608             my ( $self, $uri, $expr, $rule ) = @_;
609             unless ( $uri and $expr and $rule ) {
610             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
611             return 0;
612             }
613              
614             if ( not defined( $self->{conf}->{locationRules}->{$uri} ) ) {
615             $self->{conf}->{locationRules}->{$uri} = {};
616             }
617              
618             $self->{conf}->{locationRules}->{$uri}->{$expr} = $rule;
619             $self->{confModified} = 1;
620             }
621              
622             ## @method void rulesUnset ( string uri, string expr)
623             # Unset a rule for the given vhost
624             #
625             # @return nothing
626             sub rulesUnset {
627             my ( $self, $uri, $expr ) = @_;
628             unless ( $uri and $expr ) {
629             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
630             return 0;
631             }
632              
633             if ( not defined( $self->{conf}->{locationRules}->{$uri} ) ) {
634             $self->setError( "$uri: "
635             . $ERRORS->{CONFIG_WRITE_ERROR}
636             . ": There is rule $expr for virtual host $uri" );
637             return 0;
638             }
639              
640             delete $self->{conf}->{locationRules}->{$uri}->{$expr};
641             $self->{confModified} = 1;
642             }
643              
644             ## @method void rulesGet ( string uri )
645             # Get the rules of the given vhost
646             #
647             # @return nothing
648             sub rulesGet {
649             my ( $self, $uri ) = @_;
650             unless ($uri) {
651             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
652             return 0;
653             }
654              
655             if ( not defined( $self->{conf}->{locationRules}->{$uri} ) ) {
656             $self->setError("There is no virtual host $uri");
657             return 0;
658             }
659              
660             print "Virtual Host : $uri\n";
661              
662             while ( my ( $expr, $rule ) =
663             each %{ $self->{conf}->{locationRules}->{$uri} } )
664             {
665             print "- $expr => $rule\n";
666             }
667             }
668              
669             ## @method void exportVar ( string key, string val )
670             # export a variable
671             #
672             # @return nothing
673             sub exportVar {
674             my ( $self, $key, $val ) = @_;
675             unless ( $key and $val ) {
676             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
677             return 0;
678             }
679             $self->{conf}->{exportedVars}->{$key} = $val;
680             $self->{confModified} = 1;
681             }
682              
683             ## @method void unexportVar ( string key )
684             # unexport a variable
685             #
686             # @return nothing
687             sub unexportVar {
688             my ( $self, $key ) = @_;
689             unless ($key) {
690             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
691             return 0;
692             }
693              
694             if ( not defined( $self->{conf}->{exportedVars}->{$key} ) ) {
695             $self->setError("There is no exported variables named $key");
696             return 0;
697             }
698              
699             delete $self->{conf}->{exportedVars}->{$key};
700             $self->{confModified} = 1;
701             }
702              
703             ## @method void getExportedVars ()
704             # print the exported variables of the configuration
705             #
706             # @return nothing
707             sub getExportedVars {
708             my $self = shift;
709             while ( my ( $key, $val ) = each %{ $self->{conf}->{exportedVars} } ) {
710             print "$key = $val\n";
711             }
712             }
713              
714             ## @method void exportHeader (string $vhost, string $header, string $expr )
715             # Export a header for the given vhost
716             #
717             # @return nothing
718             sub exportHeader {
719             my ( $self, $vhost, $header, $expr ) = @_;
720             unless ( $vhost and $header and $expr ) {
721             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
722             return 0;
723             }
724              
725             if ( not defined( $self->{conf}->{exportedHeaders}->{$vhost} ) ) {
726             $self->setError( "$vhost: "
727             . $ERRORS->{CONFIG_WRITE_ERROR}
728             . ": There is no virtual host $vhost\n" );
729             return 0;
730             }
731              
732             $self->{conf}->{exportedHeaders}->{$vhost}->{$header} = $expr;
733             $self->{confModified} = 1;
734             }
735              
736             ## @method void unexportHeader ( string $vhost, string $header )
737             # Unexport the given header
738             #
739             # @return nothing
740             sub unexportHeader {
741             my ( $self, $vhost, $header ) = @_;
742             unless ( $vhost and $header ) {
743             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
744             return 0;
745             }
746              
747             if ( not defined( $self->{conf}->{exportedHeaders}->{$vhost} ) ) {
748             $self->setError( "$vhost: "
749             . $ERRORS->{CONFIG_WRITE_ERROR}
750             . ": There is no virtual host $vhost\n" );
751             return 0;
752             }
753              
754             if ( not defined( $self->{conf}->{exportedHeaders}->{$vhost}->{$header} ) )
755             {
756             $self->setError( "$_: "
757             . $ERRORS->{CONFIG_WRITE_ERROR}
758             . ": There is no header named $header exported for virtual host $vhost\n"
759             );
760             return 0;
761             }
762              
763             delete $self->{conf}->{exportedHeaders}->{$vhost}->{$header};
764             $self->{confModified} = 1;
765             }
766              
767             ## @method void getExportedHeaders ( string vhost )
768             # Give the exported headers for the given vhost
769             #
770             # @return nothing
771             sub getExportedHeaders {
772             my ( $self, $vhost ) = @_;
773             unless ($vhost) {
774             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
775             return 0;
776             }
777              
778             if ( not defined( $self->{conf}->{exportedHeaders}->{$vhost} ) ) {
779             $self->setError( "$vhost: "
780             . $ERRORS->{CONFIG_WRITE_ERROR}
781             . ": There is no virtual host $vhost\n" );
782             return 0;
783             }
784              
785             while ( my ( $header, $expr ) =
786             each %{ $self->{conf}->{exportedHeaders}->{$vhost} } )
787             {
788             print "$header : $expr\n";
789             }
790             }
791              
792             ## @method void vhostAdd ( string vhost )
793             # Add a new vhost
794             #
795             # @return nothing
796             sub vhostAdd {
797             my ( $self, $vhost ) = @_;
798             unless ($vhost) {
799             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
800             return 0;
801             }
802              
803             if ( defined( $self->{conf}->{vhostOptions}->{$vhost} )
804             or defined( $self->{conf}->{locationRules}->{$vhost} )
805             or defined( $self->{conf}->{exportedHeaders}->{$vhost} ) )
806             {
807             $self->setError( "$vhost: "
808             . $ERRORS->{CONFIG_WRITE_ERROR}
809             . ": Virtual host $vhost already exist" );
810             return 0;
811             }
812              
813             $self->{conf}->{vhostOptions}->{$vhost} =
814             $self->{subAttributes}->vhostOptions;
815             $self->{conf}->{locationRules}->{$vhost} =
816             $self->{subAttributes}->locationRules;
817             $self->{conf}->{exportedHeaders}->{$vhost} =
818             $self->{subAttributes}->exportedHeaders;
819              
820             $self->{confModified} = 1;
821              
822             }
823              
824             ## @method void vhostDel ( string vhost )
825             # Drop a vhost
826             #
827             # @return nothing
828             sub vhostDel {
829             my ( $self, $vhost ) = @_;
830             unless ($vhost) {
831             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
832             return 0;
833             }
834              
835             my $error = "No virtual host in: ";
836             my $nerror = 0;
837              
838             if ( not defined( $self->{conf}->{vhostOptions}->{$vhost} ) ) {
839             $nerror++;
840             $error .= "vhostOptions ";
841             }
842             else {
843             delete $self->{conf}->{vhostOptions}->{$vhost};
844             }
845              
846             if ( not defined( $self->{conf}->{locationRules}->{$vhost} ) ) {
847             $nerror++;
848             $error .= "locationRules ";
849             }
850             else {
851             delete $self->{conf}->{locationRules}->{$vhost};
852             }
853              
854             if ( not defined( $self->{conf}->{exportedHeaders}->{$vhost} ) ) {
855             $nerror++;
856             $error .= "exportedHeaders ";
857             }
858             else {
859             delete $self->{conf}->{exportedHeaders}->{$vhost};
860             }
861              
862             if ( $nerror == 3 ) {
863             $error .= ". aborting...";
864             $self->setError(
865             "$vhost: " . $ERRORS->{CONFIG_WRITE_ERROR} . ": $error" );
866             return 0;
867             }
868             elsif ( $nerror != 0 ) {
869             $error .= ". ignoring...";
870             $self->setError(
871             "$vhost: " . $ERRORS->{CONFIG_WRITE_ERROR} . ": $error" );
872             }
873             $self->{confModified} = 1;
874             }
875              
876             ## @method void vhostSetPort ( string vhost, int port )
877             # Set given vhost's port
878             #
879             # @return nothing
880             sub vhostSetPort {
881             my ( $self, $vhost, $port ) = @_;
882             unless ( $vhost and $port ) {
883             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
884             return 0;
885             }
886              
887             if ( not defined( $self->{conf}->{vhostOptions}->{$vhost} ) ) {
888             if ( not defined( $self->{conf}->{locationRules}->{$vhost} )
889             and not defined( $self->{conf}->{exportedHeaders}->{$vhost} ) )
890             {
891             $self->setError( "$vhost: "
892             . $ERRORS->{CONFIG_WRITE_ERROR}
893             . ": There is no virtual host $vhost" );
894             return 0;
895             }
896             else {
897             $self->{conf}->{vhostOptions}->{$vhost} = {
898             vhostPort => $port,
899             vhostHttps => $self->{subAttributes}->vhostHttps,
900             vhostMaintenance => $self->{subAttributes}->vhostMaintenance,
901             vhostAliases => $self->{subAttributes}->vhostAliases,
902             };
903             }
904             }
905             else {
906             $self->{conf}->{vhostOptions}->{$vhost}->{vhostPort} = $port;
907             }
908             $self->{confModified} = 1;
909             }
910              
911             ## @method vhostSetHttps ( string vhost, int https )
912             # Set the https parameter on the given vhost
913             #
914             # @return nothing
915             sub vhostSetHttps {
916             my ( $self, $vhost, $https ) = @_;
917             unless ( $vhost and $https ) {
918             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
919             return 0;
920             }
921             if ( not defined( $self->{conf}->{vhostOptions}->{$vhost} ) ) {
922             if ( not defined( $self->{conf}->{locationRules}->{$vhost} )
923             and not defined( $self->{conf}->{exportedHeaders}->{$vhost} ) )
924             {
925             $self->setError( "$vhost: "
926             . $ERRORS->{CONFIG_WRITE_ERROR}
927             . ": There is no virtual host $vhost" );
928             return 0;
929             }
930             else {
931             $self->{conf}->{vhostOptions}->{$vhost} = {
932             vhostPort => $self->{subAttributes}->vhostPort,
933             vhostHttps => $https,
934             vhostMaintenance => $self->{subAttributes}->vhostMaintenance,
935             vhostAliases => $self->{subAttributes}->vhostAliases,
936             };
937             }
938             }
939             else {
940             $self->{conf}->{vhostOptions}->{$vhost}->{vhostHttps} = $https;
941             }
942             $self->{confModified} = 1;
943             }
944              
945             ## @method vhostSetMaintenance ( string vhost, int off )
946             # Set the maintenance flag on a vhost
947             #
948             # @return nothing
949             sub vhostSetMaintenance {
950             my ( $self, $vhost, $off ) = @_;
951             unless ( $vhost and $off ) {
952             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
953             return 0;
954             }
955              
956             if ( not defined( $self->{conf}->{vhostOptions}->{$vhost} ) ) {
957             if ( not defined( $self->{conf}->{locationRules}->{$vhost} )
958             and not defined( $self->{conf}->{exportedHeaders}->{$vhost} ) )
959             {
960             $self->setError( "$vhost: "
961             . $ERRORS->{CONFIG_WRITE_ERROR}
962             . ": There is no virtual host $vhost" );
963             return 0;
964             }
965             else {
966             $self->{conf}->{vhostOptions}->{$vhost} = {
967             vhostPort => $self->{subAttributes}->vhostPort,
968             vhostHttps => $self->{subAttributes}->vhostHttps,
969             vhostMaintenance => $off,
970             vhostAliases => $self->{subAttributes}->vhostAliases,
971             };
972             }
973             }
974             else {
975             $self->{conf}->{vhostOptions}->{$vhost}->{vhostMaintenance} = $off;
976             }
977             $self->{confModified} = 1;
978             }
979              
980             ## @method void vhostList ()
981             # list all vhosts
982             #
983             # @return nothing
984             sub vhostList {
985             my ($self) = @_;
986              
987             foreach my $vhost ( sort keys %{ $self->{conf}->{locationRules} } ) {
988             print "- $vhost\n";
989             }
990             }
991              
992             ## @method void vhostListOptions ( string vhost )
993             # list all options of each vhosts
994             #
995             # @return nothing
996             sub vhostListOptions {
997             my ( $self, $vhost ) = @_;
998              
999             unless ($vhost) {
1000             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
1001             return 0;
1002             }
1003              
1004             my $vhostoptions = $self->{conf}->{vhostOptions}->{$vhost};
1005             if ($vhostoptions) {
1006             print "- Maintenance: $vhostoptions->{vhostMaintenance}\n";
1007             print "- Port: $vhostoptions->{vhostPort}\n";
1008             print "- HTTPS: $vhostoptions->{vhostHttps}\n";
1009             }
1010             else {
1011             print "No options defined for $vhost\n";
1012             }
1013             }
1014              
1015             ## @method reloadUrls ()
1016             # Print reloads urls by vhost
1017             #
1018             # @return nothing
1019             sub reloadUrls {
1020             my ($self) = shift;
1021              
1022             while ( my ( $vhost, $url ) = each %{ $self->{conf}->{reloadUrls} } ) {
1023             print "- $vhost => $url\n";
1024             }
1025             }
1026              
1027             ## @method void reloadUrlAdd ( string vhost, string url)
1028             # Add a new reload url for the given vhost
1029             #
1030             # @return nothing
1031             sub reloadUrlAdd {
1032             my ( $self, $vhost, $url ) = @_;
1033             unless ( $vhost and $url ) {
1034             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
1035             return 0;
1036             }
1037              
1038             $self->{conf}->{reloadUrls}->{$vhost} = $url;
1039             $self->{confModified} = 1;
1040             }
1041              
1042             ## @method void reloadUrlDel ( string vhost )
1043             # Delete the given vhost's reload url
1044             #
1045             # @return nothing
1046             sub reloadUrlDel {
1047             my ( $self, $vhost ) = @_;
1048             unless ($vhost) {
1049             $self->setError( $ERRORS->{TOO_FEW_ARGUMENTS} );
1050             return 0;
1051             }
1052              
1053             if ( not defined( $self->{conf}->{reloadUrls}->{$vhost} ) ) {
1054             $self->setError( "$vhost: "
1055             . $ERRORS->{CONFIG_WRITE_ERROR}
1056             . ": There is no reload URLs setted for $vhost" );
1057             return 0;
1058             }
1059              
1060             delete $self->{conf}->{reloadUrls}->{$vhost};
1061             $self->{confModified} = 1;
1062             }
1063              
1064             ## @method info ()
1065             # print information on configuration
1066             #
1067             # @return nothing
1068             sub info {
1069              
1070             my ($self) = @_;
1071              
1072             print "Information on current configuration:\n";
1073             print "Number: " . $self->{conf}->{cfgNum} . "\n";
1074             print "Date: "
1075             . strftime( "%Y/%m/%d %Hh%M", localtime( $self->{conf}->{cfgDate} ) )
1076             . "\n"
1077             if defined $self->{conf}->{cfgDate};
1078             print "Author: " . $self->{conf}->{cfgAuthor} . "\n"
1079             if defined $self->{conf}->{cfgAuthor};
1080             print "Author IP: " . $self->{conf}->{cfgAuthorIP} . "\n"
1081             if defined $self->{conf}->{cfgAuthorIP};
1082             }
1083              
1084             ## @method void help ()
1085             # print help message
1086             #
1087             # @return nothing
1088             sub help {
1089             my ($self) = @_;
1090              
1091             print STDERR "
1092              
1093             Global actions
1094             ==============
1095              
1096             lemonldap-ng-cli help - display this message
1097             lemonldap-ng-cli info - show current configuration information
1098             lemonldap-ng-cli update-cache - reload current configuration into cache
1099             lemonldap-ng-cli increment - save current configuration into a new one
1100              
1101             Scalar parameters (key/value form)
1102             ==================================
1103              
1104             lemonldap-ng-cli set
1105             lemonldap-ng-cli unset
1106             lemonldap-ng-cli get
1107              
1108             Hash parameters
1109             ===============
1110              
1111             lemonldap-ng-cli set-hash
1112             lemonldap-ng-cli unset-hash
1113             lemonldap-ng-cli get-hash
1114              
1115             Variables
1116             =========
1117              
1118             Exported variables
1119             ------------------
1120              
1121             lemonldap-ng-cli export-var
1122             lemonldap-ng-cli unexport-var
1123             lemonldap-ng-cli get-exported-vars
1124              
1125             Macros
1126             ------
1127              
1128             lemonldap-ng-cli set-macro
1129             lemonldap-ng-cli unset-macro
1130             lemonldap-ng-cli get-macro
1131              
1132             Application menu
1133             ================
1134              
1135             Categories
1136             ----------
1137              
1138             lemonldap-ng-cli apps-set-cat
1139             lemonldap-ng-cli apps-get-cat
1140            
1141             Applications
1142             ------------
1143              
1144             lemonldap-ng-cli apps-add
1145             lemonldap-ng-cli apps-set-uri
1146             lemonldap-ng-cli apps-set-name
1147             lemonldap-ng-cli apps-set-desc
1148             lemonldap-ng-cli apps-set-logo
1149             lemonldap-ng-cli apps-set-display
1150            
1151             lemonldap-ng-cli apps-get
1152             lemonldap-ng-cli apps-rm
1153              
1154             Virtual hosts
1155             =============
1156              
1157             lemonldap-ng-cli vhost-add
1158             lemonldap-ng-cli vhost-del
1159             lemonldap-ng-cli vhost-list
1160              
1161             Exported headers
1162             ----------------
1163              
1164             lemonldap-ng-cli export-header
1165             lemonldap-ng-cli unexport-header
1166             lemonldap-ng-cli get-exported-headers
1167              
1168             Rules
1169             -----
1170              
1171             lemonldap-ng-cli rules-set
1172             lemonldap-ng-cli rules-unset
1173             lemonldap-ng-cli rules-get
1174              
1175             Options
1176             -------
1177              
1178             lemonldap-ng-cli vhost-set-port
1179             lemonldap-ng-cli vhost-set-https
1180             lemonldap-ng-cli vhost-set-maintenance
1181             lemonldap-ng-cli vhost-list-options
1182              
1183             Reload URLs
1184             ===========
1185              
1186             lemonldap-ng-cli reload-urls
1187             lemonldap-ng-cli reload-url-add
1188             lemonldap-ng-cli reload-url-del
1189              
1190             ";
1191              
1192             }
1193              
1194             1;
1195             __END__