File Coverage

blib/lib/Lemonldap/NG/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	sub	time	code
1				package Lemonldap::NG::Cli;
2
3				# Required packages
4
5	1	1	39019	use strict;
	1		2
	1		45
6	1	1	470	use Lemonldap::NG::Common::Conf;
	0
	0
7
8				use feature qw (switch);
9
10				# Constants
11
12				our $VERSION = "0.2";
13
14				my $ERRORS =
15				{
16				TOO_FEW_ARGUMENTS => "Too few arguments",
17				UNKNOWN_ACTION => "Unknown action",
18				CONFIG_WRITE_ERROR => "Error while writting the configuration",
19				NOT_IMPLEMENTED => "Not yet implemented",
20				};
21
22				## @cmethod Lemonldap::NG::Cli new ()
23				# Create a new Lemonldap::NG::Cli object
24				#
25				# @return New Lemonldap::NG::Cli object
26				sub new
27				{
28				my ($class) = @_;
29
30				my $this =
31				{
32				"confAccess" => Lemonldap::NG::Common::Conf->new ()
33				};
34
35				$this->{conf} = $this->{confAccess}->getConf ();
36
37				bless ($this, $class);
38				return $this;
39				}
40
41				## @method int saveConf ()
42				# Save LemonLDAP::NG configuration
43				#
44				# @return Configuration identifier.
45				sub saveConf
46				{
47				my ($self) = @_;
48				my $ret = $self->{confAccess}->saveConf ($self->{conf});
49				return $ret;
50				}
51
52				## @method int run (array argv)
53				# Run the application
54				#
55				# @param @argv List of arguments of the command line
56				# @return Exit code
57				sub run
58				{
59				my ($self, @argv) = @_;
60
61				$self->{argv} = \@argv;
62				$self->{argc} = @argv;
63
64				if (!$self->parseCmd ())
65				{
66				print STDERR $self->getError (), "\n";
67				return 1;
68				}
69
70				if (!$self->action ())
71				{
72				print STDERR $self->getError (), "\n";
73				return 1;
74				}
75
76				if ($self->{action}->{save})
77				{
78				# Save configuration
79				my $cfgNb = $self->saveConf ();
80
81				# If there is no config identifier, then an error occured
82				if (!$cfgNb)
83				{
84				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR});
85				return 0;
86				}
87
88				print "Configuration $cfgNb created!\n";
89				}
90
91				return 0;
92				}
93
94				## @method bool parseCmd ()
95				# Parse command line
96				#
97				# @return true on success, false otherwise
98				sub parseCmd
99				{
100				my ($self) = @_;
101
102				# check if there is at least on action specified
103				if ($self->{argc} < 1)
104				{
105				$self->setError ($ERRORS->{TOO_FEW_ARGUMENTS});
106				return 0;
107				}
108
109				given ($self->{argv}[0])
110				{
111				## Variables
112
113				when ("set")
114				{
115				# set takes two parameters
116				if ($self->{argc} < 3)
117				{
118				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
119				return 0;
120				}
121
122				my $var = $self->{argv}[1];
123				my $val = $self->{argv}[2];
124
125				# define action
126				$self->{action} =
127				{
128				type => "set",
129				save => 1,
130				var => $var,
131				val => $val,
132				};
133				}
134
135				when ("unset")
136				{
137				# unset takes one parameter
138				if ($self->{argc} < 2)
139				{
140				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
141				return 0;
142				}
143
144				my $var = $self->{argv}[1];
145
146				# define action
147				$self->{action} =
148				{
149				type => "unset",
150				save => 1,
151				var => $var
152				};
153				}
154
155				when ("get")
156				{
157				# get takes one parameter
158				if ($self->{argc} < 2)
159				{
160				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
161				return 0;
162				}
163
164				my $var = $self->{argv}[1];
165
166				# define action
167				$self->{action} =
168				{
169				type => "get",
170				save => 0,
171				var => $var,
172				};
173				}
174
175				## Macros
176
177				when ("set-macro")
178				{
179				# set-macro takes two parameters
180				if ($self->{argc} < 3)
181				{
182				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
183				return 0;
184				}
185
186				my $m_name = $self->{argv}[1];
187				my $m_expr = $self->{argv}[2];
188
189				# define action
190				$self->{action} =
191				{
192				type => "set-macro",
193				save => 1,
194				name => $m_name,
195				expr => $m_expr
196				};
197				}
198
199				when ("unset-macro")
200				{
201				# unset-macro takes one parameter
202				if ($self->{argc} < 2)
203				{
204				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
205				return 0;
206				}
207
208				my $m_name = $self->{argv}[1];
209
210				# define action
211				$self->{action} =
212				{
213				type => "unset-macro",
214				save => 1,
215				var => $m_name
216				};
217
218				}
219
220				when ("get-macro")
221				{
222				# get-macro tkaes one parameter
223				if ($self->{argc} < 2)
224				{
225				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
226				return 0;
227				}
228
229				my $m_name = $self->{argv}[1];
230
231				# define action
232				$self->{action} =
233				{
234				type => "get-macro",
235				save => 0,
236				name => $m_name
237				};
238				}
239
240				## Applications
241
242				when ("apps-set-cat")
243				{
244				# apps-set-cat takes two parameter
245				if ($self->{argc} < 3)
246				{
247				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
248				return 0;
249				}
250
251				my $catid = $self->{argv}[1];
252				my $catname = $self->{argv}[2];
253
254				# define action
255				$self->{action} =
256				{
257				type => "apps-set-cat",
258				save => 1,
259				id => $catid,
260				name => $catname
261				};
262				}
263
264				when ("apps-get-cat")
265				{
266				# apps-get-cat takes one parameter
267				if ($self->{argc} < 2)
268				{
269				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
270				return 0;
271				}
272
273				my $catid = $self->{argv}[1];
274
275				# define action
276				$self->{action} =
277				{
278				type => "apps-get-cat",
279				save => 0,
280				id => $catid
281				};
282				}
283
284				when ("apps-add")
285				{
286				# apps-add takes two parameters
287				if ($self->{argc} < 3)
288				{
289				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
290				return 0;
291				}
292
293				my $appid = $self->{argv}[1];
294				my $catid = $self->{argv}[2];
295
296				# define action
297				$self->{action} =
298				{
299				type => "apps-add",
300				save => 1,
301				appid => $appid,
302				catid => $catid
303				};
304				}
305
306				when ("apps-set-uri")
307				{
308				# apps-set-uri takes two parameters
309				if ($self->{argc} < 3)
310				{
311				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
312				return 0;
313				}
314
315				my $appid = $self->{argv}[1];
316				my $appuri = $self->{argv}[2];
317
318				# define action
319				$self->{action} =
320				{
321				type => "apps-set-uri",
322				save => 1,
323				id => $appid,
324				uri => $appuri
325				};
326				}
327
328				when ("apps-set-name")
329				{
330				# apps-set-name takes two parameters
331				if ($self->{argc} < 3)
332				{
333				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
334				return 0;
335				}
336
337				my $appid = $self->{argv}[1];
338				my $appname = $self->{argv}[2];
339
340				# define action
341				$self->{action} =
342				{
343				type => "apps-set-name",
344				save => 1,
345				id => $appid,
346				name => $appname
347				};
348				}
349
350				when ("apps-set-desc")
351				{
352				# apps-set-desc takes two parameters
353				if ($self->{argc} < 3)
354				{
355				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
356				return 0;
357				}
358
359				my $appid = $self->{argv}[1];
360				my $appdesc = $self->{argv}[2];
361
362				# define action
363				$self->{action} =
364				{
365				type => "apps-set-desc",
366				save => 1,
367				id => $appid,
368				desc => $appdesc
369				};
370				}
371
372				when ("apps-set-logo")
373				{
374				# apps-set-logo takes two parameters
375				if ($self->{argc} < 3)
376				{
377				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
378				return 0;
379				}
380
381				my $appid = $self->{argv}[1];
382				my $applogo = $self->{argv}[2];
383
384				# define action
385				$self->{action} =
386				{
387				type => "apps-set-logo",
388				save => 1,
389				id => $appid,
390				logo => $applogo
391				};
392				}
393
394				when ("apps-set-display")
395				{
396				# apps-set-display takes two parameters
397				if ($self->{argc} < 3)
398				{
399				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
400				return 0;
401				}
402
403				my $appid = $self->{argv}[1];
404				my $appdpy = $self->{argv}[2];
405
406				# define action
407				$self->{action} =
408				{
409				type => "apps-set-display",
410				save => 1,
411				id => $appid,
412				dpy => $appdpy
413				};
414				}
415
416				when ("apps-get")
417				{
418				# apps-get takes one parameter
419				if ($self->{argc} < 2)
420				{
421				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
422				return 0;
423				}
424
425				my $appid = $self->{argv}[1];
426
427				# define action
428				$self->{action} =
429				{
430				type => "apps-get",
431				save => 0,
432				id => $appid
433				};
434				}
435
436				when ("apps-rm")
437				{
438				# apps-rm takes one parameter
439				if ($self->{argc} < 2)
440				{
441				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
442				return 0;
443				}
444
445				my $appid = $self->{argv}[1];
446
447				# define action
448				$self->{action} =
449				{
450				type => "apps-rm",
451				save => 1,
452				id => $appid
453				};
454				}
455
456				## Rules
457
458				when ("rules-set")
459				{
460				# rules-set takes 3 parameters
461				if ($self->{argc} < 4)
462				{
463				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
464				return 0;
465				}
466
467				my $uri = $self->{argv}[1];
468				my $expr = $self->{argv}[2];
469				my $rule = $self->{argv}[3];
470
471				# define action
472				$self->{action} =
473				{
474				type => "rules-set",
475				save => 1,
476				uri => $uri,
477				expr => $expr,
478				rule => $rule
479				};
480				}
481
482				when ("rules-unset")
483				{
484				# rules-unset takes two parameters
485				if ($self->{argc} < 3)
486				{
487				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
488				return 0;
489				}
490
491				my $uri = $self->{argv}[1];
492				my $expr = $self->{argv}[2];
493
494				# define action
495				$self->{action} =
496				{
497				type => "rules-unset",
498				save => 1,
499				uri => $uri,
500				expr => $expr
501				};
502				}
503
504				when ("rules-get")
505				{
506				# rules-get takes one parameter
507				if ($self->{argc} < 2)
508				{
509				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
510				return 0;
511				}
512
513				my $uri = $self->{argv}[1];
514
515				# define action
516				$self->{action} =
517				{
518				type => "rules-get",
519				save => 0,
520				uri => $uri
521				};
522				}
523
524				## exported variables
525
526				when ("export-var")
527				{
528				# export-var takes two parameters
529				if ($self->{argc} < 3)
530				{
531				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
532				return 0;
533				}
534
535				my $key = $self->{argv}[1];
536				my $val = $self->{argv}[2];
537
538				# define action
539				$self->{action} =
540				{
541				type => "export-var",
542				save => 1,
543				key => $key,
544				val => $val
545				};
546				}
547
548				when ("unexport-var")
549				{
550				# unexport-var takes one parameter
551				if ($self->{argc} < 2)
552				{
553				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
554				return 0;
555				}
556
557				my $key = $self->{argv}[1];
558
559				# define action
560				$self->{action} =
561				{
562				type => "unexport-var",
563				save => 1,
564				key => $key
565				};
566				}
567
568				when ("get-exported-vars")
569				{
570				# get-exported-varis doesn't take any parameter
571
572				# define action
573				$self->{action} =
574				{
575				type => "get-exported-vars",
576				save => 0
577				};
578				}
579
580				## exported headers
581
582				when ("export-header")
583				{
584				# export-header takes 3 parameters
585				if ($self->{argc} < 4)
586				{
587				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
588				return 0;
589				}
590
591				my $vhost = $self->{argv}[1];
592				my $header = $self->{argv}[2];
593				my $expr = $self->{argv}[3];
594
595				# define action
596				$self->{action} =
597				{
598				type => "export-header",
599				save => 1,
600				vhost => $vhost,
601				header => $header,
602				expr => $expr
603				};
604				}
605
606				when ("unexport-header")
607				{
608				# unexport-header takes two parameter
609				if ($self->{argc} < 3)
610				{
611				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
612				return 0;
613				}
614
615				my $vhost = $self->{argv}[1];
616				my $header = $self->{argv}[2];
617
618				# define action
619				$self->{action} =
620				{
621				type => "unexport-header",
622				save => 1,
623				vhost => $vhost,
624				header => $header,
625				};
626				}
627
628				when ("get-exported-headers")
629				{
630				# get-exported-header takes one parameter
631				if ($self->{argc} < 2)
632				{
633				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
634				return 0;
635				}
636
637				my $vhost = $self->{argv}[1];
638
639				# define action
640				$self->{action} =
641				{
642				type => "get-exported-headers",
643				save => 0,
644				vhost => $vhost
645				};
646				}
647
648				## virtual host
649
650				when ("vhost-add")
651				{
652				# vhost-add takes one parameter
653				if ($self->{argc} < 2)
654				{
655				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
656				return 0;
657				}
658
659				my $vhost = $self->{argv}[1];
660
661				# define action
662				$self->{action} =
663				{
664				type => "vhost-add",
665				save => 1,
666				vhost => $vhost
667				};
668				}
669
670				when ("vhost-del")
671				{
672				# vhost-del takes one parameter
673				if ($self->{argc} < 2)
674				{
675				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
676				return 0;
677				}
678
679				my $vhost = $self->{argv}[1];
680
681				# define action
682				$self->{action} =
683				{
684				type => "vhost-del",
685				save => 1,
686				vhost => $vhost
687				};
688				}
689
690				when ("vhost-set-port")
691				{
692				# vhost-set-port takes two parameters
693				if ($self->{argc} < 3)
694				{
695				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
696				return 0;
697				}
698
699				my $vhost = $self->{argv}[1];
700				my $port = $self->{argv}[2];
701
702				# define action
703				$self->{action} =
704				{
705				type => "vhost-set-port",
706				save => 1,
707				vhost => $vhost,
708				port => $port
709				};
710				}
711
712				when ("vhost-set-https")
713				{
714				# vhost-set-https takes two parameters
715				if ($self->{argc} < 3)
716				{
717				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
718				return 0;
719				}
720
721				my $vhost = $self->{argv}[1];
722				my $https = $self->{argv}[2];
723
724				# define action
725				$self->{action} =
726				{
727				type => "vhost-set-https",
728				save => 1,
729				vhost => $vhost,
730				https => $https
731				};
732				}
733
734
735				when ("vhost-set-maintenance")
736				{
737				# vhost-set-maintenance takes two parameters
738				if ($self->{argc} < 3)
739				{
740				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
741				return 0;
742				}
743
744				my $vhost = $self->{argv}[1];
745				my $off = $self->{argv}[2];
746
747				# define action
748				$self->{action} =
749				{
750				type => "vhost-set-maintenance",
751				save => 1,
752				vhost => $vhost,
753				off => $off
754				};
755				}
756
757				when ("vhost-list")
758				{
759				# vhost-list doesn't take any parameter
760
761				# define action
762				$self->{action} =
763				{
764				type => "vhost-list",
765				save => 0
766				};
767				}
768
769				## global storage
770
771				when ("global-storage")
772				{
773				# global-storage doesn't take any parameter
774
775				# define action
776				$self->{action} =
777				{
778				type => "global-storage",
779				save => 0
780				};
781				}
782
783				when ("global-storage-set-dir")
784				{
785				# global-storage takes one parameter
786				if ($self->{argc} < 2)
787				{
788				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
789				return 0;
790				}
791
792				my $path = $self->{argv}[1];
793
794				# define action
795				$self->{action} =
796				{
797				type => "global-storage-set-dir",
798				save => 1,
799				path => $path
800				};
801				}
802
803				when ("global-storage-set-lockdir")
804				{
805				# global-storage takes one parameter
806				if ($self->{argc} < 2)
807				{
808				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
809				return 0;
810				}
811
812				my $path = $self->{argv}[1];
813
814				# define action
815				$self->{action} =
816				{
817				type => "global-storage-set-lockdir",
818				save => 1,
819				path => $path
820				};
821				}
822
823				## reload URLs
824
825				when ("reload-urls")
826				{
827				# reload-urls doesn't take any parameter
828
829				# define action
830				$self->{action} =
831				{
832				type => "reload-urls",
833				save => 0
834				};
835				}
836
837				when ("reload-url-add")
838				{
839				# reload-url-add takes two parameters
840				if ($self->{argc} < 3)
841				{
842				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
843				return 0;
844				}
845
846				my $vhost = $self->{argv}[1];
847				my $url = $self->{argv}[2];
848
849				# define action
850				$self->{action} =
851				{
852				type => "reload-url-add",
853				save => 0,
854				vhost => $vhost,
855				url => $url
856				};
857				}
858
859				when ("reload-url-del")
860				{
861				# reload-url-del takes one parameter
862				if ($self->{argc} < 2)
863				{
864				$self->setError ("$_: ".$ERRORS->{TOO_FEW_ARGUMENTS});
865				return 0;
866				}
867
868				my $vhost = $self->{argv}[1];
869
870				# define action
871				$self->{action} =
872				{
873				type => "reload-url-del",
874				save => 0,
875				vhost => $vhost
876				};
877				}
878
879				# no action found
880				default
881				{
882				$self->setError ("$_: ".$ERRORS->{UNKNOWN_ACTION});
883				return 0;
884				}
885				}
886
887				return 1;
888				}
889
890				## @method bool action ()
891				# Execute action parsed by parseCmd() method
892				#
893				# @return true on success, false otherwise
894				sub action
895				{
896				my ($self) = @_;
897
898				given ($self->{action}->{type})
899				{
900				## Variables
901
902				when ("set")
903				{
904				my $var = $self->{action}->{var};
905				my $val = $self->{action}->{val};
906
907				$self->{conf}->{$var} = $val;
908				}
909
910				when ("unset")
911				{
912				my $var = $self->{action}->{var};
913
914				if (not defined ($self->{conf}->{$var}))
915				{
916				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": There is no variables named '$var'");
917				return 0;
918				}
919
920				delete $self->{conf}->{$var};
921				}
922
923				when ("get")
924				{
925				my $var = $self->{action}->{var};
926
927				if (not defined ($self->{conf}->{$var}))
928				{
929				$self->setError ("$_: There is no variables named '$var'");
930				return 0;
931				}
932
933				print "$var = '", $self->{conf}->{$var}, "'\n";
934				}
935
936				## Macros
937
938				when ("set-macro")
939				{
940				my $m_name = $self->{action}->{name};
941				my $m_expr = $self->{action}->{expr};
942
943				$self->{conf}->{macros}->{$m_name} = $m_expr;
944				}
945
946				when ("unset-macro")
947				{
948				my $m_name = $self->{action}->{name};
949
950				if (not defined ($self->{conf}->{macros}->{$m_name}))
951				{
952				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": There is no macros named '$m_name'");
953				return 0;
954				}
955
956				delete $self->{conf}->{macros}->{$m_name};
957				}
958
959				when ("get-macro")
960				{
961				my $m_name = $self->{action}->{name};
962
963				if (not defined ($self->{conf}->{macros}->{$m_name}))
964				{
965				$self->setError ("$_: There is no macros named '$m_name'");
966				return 0;
967				}
968
969				print "$m_name = '", $self->{conf}->{macros}->{$m_name}, "'\n";
970				}
971
972				## Applications
973
974				when ("apps-set-cat")
975				{
976				my $catid = $self->{action}->{id};
977				my $catname = $self->{action}->{name};
978
979				if (defined ($self->{conf}->{applicationList}->{$catid}))
980				{
981				$self->{conf}->{applicationList}->{$catid}->{catname} = $catname;
982				}
983				else
984				{
985				$self->{conf}->{applicationList}->{$catid} =
986				{
987				type => "category",
988				catname => $catname
989				};
990				}
991				}
992
993				when ("apps-get-cat")
994				{
995				my $catid = $self->{action}->{id};
996
997				if (not defined ($self->{conf}->{applicationList}->{$catid}))
998				{
999				$self->setError ("$_: There is no category '$catid'");
1000				return 0;
1001				}
1002
1003				print "$catid: ", $self->{conf}->{applicationList}->{$catid}->{catname}, "\n";
1004				}
1005
1006				when ("apps-add")
1007				{
1008				my $appid = $self->{action}->{appid};
1009				my $catid = $self->{action}->{catid};
1010
1011				if (not defined ($self->{conf}->{applicationList}->{$catid}))
1012				{
1013				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": Category '$catid' doesn't exist");
1014				return 0;
1015				}
1016
1017				if (defined ($self->{conf}->{applicationList}->{$catid}->{$appid}))
1018				{
1019				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": Application '$appid' exists");
1020				return 0;
1021				}
1022
1023				$self->{conf}->{applicationList}->{$catid}->{$appid} =
1024				{
1025				type => "application",
1026				options =>
1027				{
1028				logo => "demo.png",
1029				name => $appid,
1030				description => $appid,
1031				display => "auto",
1032				uri => "http://test1.example.com"
1033				}
1034				};
1035				}
1036
1037				when ("apps-set-uri")
1038				{
1039				my $appid = $self->{action}->{id};
1040				my $appuri = $self->{action}->{uri};
1041
1042				my $found = 0;
1043				while (my ($catid, $applist) = each %{$self->{conf}->{applicationList}} and $found != 1)
1044				{
1045				while (my ($_appid, $app) = each %{$applist} and $found != 1)
1046				{
1047				if ($appid eq $_appid)
1048				{
1049				$app->{options}->{uri} = $appuri;
1050				$found = 1;
1051				}
1052				}
1053				}
1054
1055				if ($found == 0)
1056				{
1057				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": Application '$appid' not found");
1058				return 0;
1059				}
1060				}
1061
1062				when ("apps-set-name")
1063				{
1064				my $appid = $self->{action}->{id};
1065				my $appname = $self->{action}->{name};
1066
1067				my $found = 0;
1068				while (my ($catid, $applist) = each %{$self->{conf}->{applicationList}} and $found != 1)
1069				{
1070				while (my ($_appid, $app) = each %{$applist} and $found != 1)
1071				{
1072				if ($appid eq $_appid)
1073				{
1074				$app->{options}->{name} = $appname;
1075				$found = 1;
1076				}
1077				}
1078				}
1079
1080				if ($found == 0)
1081				{
1082				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": Application '$appid' not found");
1083				return 0;
1084				}
1085				}
1086
1087				when ("apps-set-desc")
1088				{
1089				my $appid = $self->{action}->{id};
1090				my $appdesc = $self->{action}->{desc};
1091
1092				my $found = 0;
1093				while (my ($catid, $applist) = each %{$self->{conf}->{applicationList}} and $found != 1)
1094				{
1095				while (my ($_appid, $app) = each %{$applist} and $found != 1)
1096				{
1097				if ($appid eq $_appid)
1098				{
1099				$app->{options}->{description} = $appdesc;
1100				$found = 1;
1101				}
1102				}
1103				}
1104
1105				if ($found == 0)
1106				{
1107				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": Application '$appid' not found");
1108				return 0;
1109				}
1110				}
1111
1112				when ("apps-set-logo")
1113				{
1114				my $appid = $self->{action}->{id};
1115				my $applogo = $self->{action}->{logo};
1116
1117				my $found = 0;
1118				while (my ($catid, $applist) = each %{$self->{conf}->{applicationList}} and $found != 1)
1119				{
1120				while (my ($_appid, $app) = each %{$applist} and $found != 1)
1121				{
1122				if ($appid eq $_appid)
1123				{
1124				$app->{options}->{logo} = $applogo;
1125				$found = 1;
1126				}
1127				}
1128				}
1129
1130				if ($found == 0)
1131				{
1132				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": Application '$appid' not found");
1133				return 0;
1134				}
1135				}
1136
1137				when ("apps-set-display")
1138				{
1139				my $appid = $self->{action}->{id};
1140				my $appdpy = $self->{action}->{dpy};
1141
1142				my $found = 0;
1143				while (my ($catid, $applist) = each %{$self->{conf}->{applicationList}} and $found != 1)
1144				{
1145				while (my ($_appid, $app) = each %{$applist} and $found != 1)
1146				{
1147				if ($appid eq $_appid)
1148				{
1149				$app->{options}->{display} = $appdpy;
1150				$found = 1;
1151				}
1152				}
1153				}
1154
1155				if ($found == 0)
1156				{
1157				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": Application '$appid' not found");
1158				return 0;
1159				}
1160				}
1161
1162				when ("apps-get")
1163				{
1164				my $appid = $self->{action}->{id};
1165
1166				my $found = 0;
1167				while (my ($catid, $applist) = each %{$self->{conf}->{applicationList}} and $found != 1)
1168				{
1169				while (my ($_appid, $app) = each %{$applist} and $found != 1)
1170				{
1171				if ($appid eq $_appid)
1172				{
1173				print "Category '$catid': ".$self->{conf}->{applicationList}->{$catid}->{catname}."\n";
1174				print "Application '$appid': ".$app->{options}->{name}."\n";
1175				print "- Description: ".$app->{options}->{description}."\n";
1176				print "- URI: ".$app->{options}->{uri}."\n";
1177				print "- Logo: ".$app->{options}->{logo}."\n";
1178				print "- Display: ".$app->{options}->{display}."\n";
1179				$found = 1;
1180				}
1181				}
1182				}
1183
1184				if ($found == 0)
1185				{
1186				$self->setError ("$_: Application '$appid' not found");
1187				return 0;
1188				}
1189				}
1190
1191				when ("apps-rm")
1192				{
1193				my $appid = $self->{action}->{id};
1194
1195				my $found = 0;
1196				while (my ($catid, $applist) = each %{$self->{conf}->{applicationList}} and $found != 1)
1197				{
1198				while (my ($_appid, $app) = each %{$applist} and $found != 1)
1199				{
1200				if ($appid eq $_appid)
1201				{
1202				delete $applist->{$appid};
1203				$found = 1;
1204				}
1205				}
1206				}
1207				}
1208
1209				## Rules
1210
1211				when ("rules-set")
1212				{
1213				my $uri = $self->{action}->{uri};
1214				my $expr = $self->{action}->{expr};
1215				my $rule = $self->{action}->{rule};
1216
1217				if (not defined ($self->{conf}->{locationRules}->{$uri}))
1218				{
1219				$self->{conf}->{locationRules}->{$uri} = {};
1220				}
1221
1222				$self->{conf}->{locationRules}->{$uri}->{$expr} = $rule;
1223				}
1224
1225				when ("rules-unset")
1226				{
1227				my $uri = $self->{action}->{uri};
1228				my $expr = $self->{action}->{expr};
1229
1230				if (not defined ($self->{conf}->{locationRules}->{$uri}))
1231				{
1232				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": There is no virtual host '$uri'");
1233				return 0;
1234				}
1235
1236				if (not defined ($self->{conf}->{locationRules}->{$uri}->{$expr}))
1237				{
1238				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": There is rule '$expr' for virtual host '$uri'");
1239				return 0;
1240				}
1241
1242				delete $self->{conf}->{locationRules}->{$uri}->{$expr};
1243				}
1244
1245				when ("rules-get")
1246				{
1247				my $uri = $self->{action}->{uri};
1248
1249				if (not defined ($self->{conf}->{locationRules}->{$uri}))
1250				{
1251				$self->setError ("$_: There is no virtual host '$uri'");
1252				return 0;
1253				}
1254
1255				print "Virtual Host : $uri\n";
1256				while (my ($expr, $rule) = each %{$self->{conf}->{locationRules}->{$uri}})
1257				{
1258				print "- $expr => '$rule'\n";
1259				}
1260				}
1261
1262				## exported variables
1263
1264				when ("export-var")
1265				{
1266				my $key = $self->{action}->{key};
1267				my $val = $self->{action}->{val};
1268
1269				$self->{conf}->{exportedVars}->{$key} = $val;
1270				}
1271
1272				when ("unexport-var")
1273				{
1274				my $key = $self->{action}->{key};
1275
1276				if (not defined ($self->{conf}->{exportedVars}->{$key}))
1277				{
1278				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": There is no exported variables named '$key'");
1279				return 0;
1280				}
1281
1282				delete $self->{conf}->{exportedVars}->{$key};
1283				}
1284
1285				when ("get-exported-vars")
1286				{
1287				while (my ($key, $val) = each %{$self->{conf}->{exportedVars}})
1288				{
1289				print "$key = $val\n";
1290				}
1291				}
1292
1293				## exported headers
1294
1295				when ("export-header")
1296				{
1297				my $vhost = $self->{action}->{vhost};
1298				my $header = $self->{action}->{header};
1299				my $expr = $self->{action}->{expr};
1300
1301				if (not defined ($self->{conf}->{exportedHeaders}->{$vhost}))
1302				{
1303				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": There is no virtual host '$vhost'\n");
1304				return 0;
1305				}
1306
1307				$self->{conf}->{exportedHeaders}->{$vhost}->{$header} = $expr;
1308				}
1309
1310				when ("unexport-header")
1311				{
1312				my $vhost = $self->{action}->{vhost};
1313				my $header = $self->{action}->{header};
1314				my $expr = $self->{action}->{expr};
1315
1316				if (not defined ($self->{conf}->{exportedHeaders}->{$vhost}))
1317				{
1318				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": There is no virtual host '$vhost'\n");
1319				return 0;
1320				}
1321
1322				if (not defined ($self->{conf}->{exportedHeaders}->{$vhost}->{$header}))
1323				{
1324				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": There is no header named '$header' exported for virtual host '$vhost'\n");
1325				return 0;
1326				}
1327
1328				delete $self->{conf}->{exportedHeaders}->{$vhost}->{$header};
1329				}
1330
1331				when ("get-exported-headers")
1332				{
1333				my $vhost = $self->{action}->{vhost};
1334
1335				if (not defined ($self->{conf}->{exportedHeaders}->{$vhost}))
1336				{
1337				$self->setError ("$_: There is no virtual host '$vhost'\n");
1338				return 0;
1339				}
1340
1341				while (my ($header, $expr) = each %{$self->{conf}->{exportedHeaders}->{$vhost}})
1342				{
1343				print "$header: '$expr'\n";
1344				}
1345				}
1346
1347				## virtual hosts
1348
1349				when ("vhost-add")
1350				{
1351				my $vhost = $self->{action}->{vhost};
1352
1353				if (defined ($self->{conf}->{vhostOptions}->{$vhost}) or defined ($self->{conf}->{locationRules}->{$vhost}) or defined ($self->{conf}->{exportedHeaders}->{$vhost}))
1354				{
1355				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": Virtual host '$vhost' already exist");
1356				return 0;
1357				}
1358
1359				$self->{conf}->{vhostOptions}->{$vhost} =
1360				{
1361				vhostMaintenance => '0',
1362				vhostPort => '-1',
1363				vhostHttps => '-1'
1364				};
1365				$self->{conf}->{locationRules}->{$vhost} =
1366				{
1367				default => "deny"
1368				};
1369				$self->{conf}->{exportedHeaders}->{$vhost} =
1370				{
1371				"Auth-User" => "\$uid"
1372				};
1373				}
1374
1375				when ("vhost-del")
1376				{
1377				my $vhost = $self->{action}->{vhost};
1378				my $error = "No virtual host in: ";
1379				my $nerror = 0;
1380
1381				if (not defined ($self->{conf}->{vhostOptions}->{$vhost}))
1382				{
1383				$nerror++;
1384				$error .= "vhostOptions ";
1385				}
1386				else
1387				{
1388				delete $self->{conf}->{vhostOptions}->{$vhost};
1389				}
1390
1391				if (not defined ($self->{conf}->{locationRules}->{$vhost}))
1392				{
1393				$nerror++;
1394				$error .= "locationRules ";
1395				}
1396				else
1397				{
1398				delete $self->{conf}->{locationRules}->{$vhost};
1399				}
1400
1401				if (not defined ($self->{conf}->{exportedHeaders}->{$vhost}))
1402				{
1403				$nerror++;
1404				$error .= "exportedHeaders";
1405				}
1406				else
1407				{
1408				delete $self->{conf}->{exportedHeaders}->{$vhost};
1409				}
1410
1411				if ($nerror == 3)
1412				{
1413				$error .= ". abortting...";
1414				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": $error");
1415				return 0;
1416				}
1417				elsif ($nerror != 0)
1418				{
1419				$error .= ". ignoring...";
1420				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": $error");
1421				}
1422				}
1423
1424				when ("vhost-set-port")
1425				{
1426				my $vhost = $self->{action}->{vhost};
1427				my $port = $self->{action}->{port};
1428
1429				if (not defined ($self->{conf}->{vhostOptions}->{$vhost}))
1430				{
1431				if (not defined ($self->{conf}->{locationRules}->{$vhost}) and not defined ($self->{conf}->{exportedHeaders}->{$vhost}))
1432				{
1433				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": There is no virtual host '$vhost'");
1434				return 0;
1435				}
1436				else
1437				{
1438				$self->{conf}->{vhostOptions}->{$vhost} =
1439				{
1440				vhostPort => $port,
1441				vhostHttps => '-1',
1442				vhostMaintenance => '0'
1443				};
1444				}
1445				}
1446				else
1447				{
1448				$self->{conf}->{vhostOptions}->{$vhost}->{vhostPort} = $port;
1449				}
1450				}
1451
1452				when ("vhost-set-https")
1453				{
1454				my $vhost = $self->{action}->{vhost};
1455				my $https = $self->{action}->{https};
1456
1457				if (not defined ($self->{conf}->{vhostOptions}->{$vhost}))
1458				{
1459				if (not defined ($self->{conf}->{locationRules}->{$vhost}) and not defined ($self->{conf}->{exportedHeaders}->{$vhost}))
1460				{
1461				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": There is no virtual host '$vhost'");
1462				return 0;
1463				}
1464				else
1465				{
1466				$self->{conf}->{vhostOptions}->{$vhost} =
1467				{
1468				vhostPort => '-1',
1469				vhostHttps => $https,
1470				vhostMaintenance => '0'
1471				};
1472				}
1473				}
1474				else
1475				{
1476				$self->{conf}->{vhostOptions}->{$vhost}->{vhostHttps} = $https;
1477				}
1478				}
1479
1480				when ("vhost-set-maintenance")
1481				{
1482				my $vhost = $self->{action}->{vhost};
1483				my $off = $self->{action}->{off};
1484
1485				if (not defined ($self->{conf}->{vhostOptions}->{$vhost}))
1486				{
1487				if (not defined ($self->{conf}->{locationRules}->{$vhost}) and not defined ($self->{conf}->{exportedHeaders}->{$vhost}))
1488				{
1489				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": There is no virtual host '$vhost'");
1490				return 0;
1491				}
1492				else
1493				{
1494				$self->{conf}->{vhostOptions}->{$vhost} =
1495				{
1496				vhostPort => '-1',
1497				vhostHttps => '-1',
1498				vhostMaintenance => $off
1499				};
1500				}
1501				}
1502				else
1503				{
1504				$self->{conf}->{vhostOptions}->{$vhost}->{vhostMaintenance} = $off;
1505				}
1506				}
1507
1508				when ("vhost-list")
1509				{
1510				while (my ($vhost, $vhostoptions) = each %{$self->{conf}->{vhostOptions}})
1511				{
1512				print "- $vhost => ";
1513				print "Maintenance: $vhostoptions->{vhostMaintenance} \| ";
1514				print "Port: $vhostoptions->{vhostPort} \| ";
1515				print "HTTPS: $vhostoptions->{vhostHttps}\n";
1516				}
1517				}
1518
1519				## global storage
1520
1521				when ("global-storage")
1522				{
1523				print "Global Storage options :\n";
1524				print "- Directory: $self->{conf}->{globalStorageOptions}->{Directory}\n";
1525				print "- Lock Directory: $self->{conf}->{globalStorageOptions}->{LockDirectory}\n";
1526				}
1527
1528				when ("global-storage-set-dir")
1529				{
1530				my $path = $self->{action}->{path};
1531
1532				$self->{conf}->{globalStorageOptions}->{Directory} = $path;
1533				}
1534
1535				when ("global-storage-set-lockdir")
1536				{
1537				my $path = $self->{action}->{path};
1538
1539				$self->{conf}->{globalStorageOptions}->{LockDirectory} = $path;
1540				}
1541
1542				when ("reload-urls")
1543				{
1544				while (my ($vhost, $url) = each %{$self->{conf}->{reloadUrls}})
1545				{
1546				print "- $vhost => $url\n";
1547				}
1548				}
1549
1550				when ("reload-url-add")
1551				{
1552				my $vhost = $self->{action}->{vhost};
1553				my $url = $self->{action}->{url};
1554
1555				$self->{conf}->{reloadUrls}->{$vhost} = $url;
1556				}
1557
1558				when ("reload-url-del")
1559				{
1560				my $vhost = $self->{action}->{vhost};
1561
1562				if (not defined ($self->{conf}->{reloadUrls}->{$vhost}))
1563				{
1564				$self->setError ("$_: ".$ERRORS->{CONFIG_WRITE_ERROR}.": There is no reload URLs setted for '$vhost'");
1565				return 1;
1566				}
1567
1568				delete $self->{conf}->{reloadUrls}->{$vhost};
1569				}
1570
1571				# no implementation found
1572				default
1573				{
1574				$self->setError ("$_: ".$ERRORS->{NOT_IMPLEMENTED});
1575				return 0;
1576				}
1577				}
1578
1579				return 1;
1580				}
1581
1582				## @method void setError (string str)
1583				# Set error message
1584				#
1585				# @param str Text of the error
1586				sub setError
1587				{
1588				my ($self, $msg) = @_;
1589
1590				$self->{errormsg} = $msg;
1591				}
1592
1593				## @method string getError ()
1594				# Get error message
1595				#
1596				# @return Text of the error
1597				sub getError
1598				{
1599				my ($self) = @_;
1600
1601				my $msg = $self->{errormsg};
1602
1603				return $msg;
1604				}
1605
1606				1;
1607				__END__