@@ -0,0 +1,138 | |||||
|
1 | #!/usr/bin/perl | |||
|
2 | # | |||
|
3 | # redMine is free software; you can redistribute it and/or | |||
|
4 | # modify it under the terms of the GNU General Public License | |||
|
5 | # as published by the Free Software Foundation; either version 2 | |||
|
6 | # of the License, or (at your option) any later version. | |||
|
7 | # | |||
|
8 | # This program is distributed in the hope that it will be useful, | |||
|
9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |||
|
10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |||
|
11 | # GNU General Public License for more details. | |||
|
12 | # | |||
|
13 | # You should have received a copy of the GNU General Public License | |||
|
14 | # along with this program; if not, write to the Free Software | |||
|
15 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. | |||
|
16 | ||||
|
17 | use strict; | |||
|
18 | use SOAP::Lite; | |||
|
19 | use Getopt::Long; | |||
|
20 | Getopt::Long::Configure ("bundling", "no_auto_abbrev", "no_ignore_case"); | |||
|
21 | use Pod::Usage; | |||
|
22 | use vars qw/$VERSION/; | |||
|
23 | ||||
|
24 | $VERSION = "1.0"; | |||
|
25 | ||||
|
26 | my %opts = (verbose => 0); | |||
|
27 | GetOptions(\%opts, 'verbose|v+', 'version|V', 'help|h', 'man|m', 'quiet|q', 'svn-dir|s=s', 'redmine-host|r=s') or pod2usage(2); | |||
|
28 | ||||
|
29 | die "$VERSION\n" if $opts{version}; | |||
|
30 | pod2usage(1) if $opts{help}; | |||
|
31 | pod2usage( -verbose => 2 ) if $opts{man}; | |||
|
32 | ||||
|
33 | my $repos_base = $opts{'svn-dir'}; | |||
|
34 | my $redmine_host = $opts{'redmine-host'}; | |||
|
35 | ||||
|
36 | pod2usage(2) unless $repos_base and $redmine_host; | |||
|
37 | ||||
|
38 | unless (-d $repos_base) { | |||
|
39 | Log(text => "$repos_base doesn't exist", exit => 1); | |||
|
40 | } | |||
|
41 | ||||
|
42 | Log(level => 1, text => "querying redMine for projects..."); | |||
|
43 | my $wdsl = "http://$redmine_host/sys/service.wsdl"; | |||
|
44 | my $service = SOAP::Lite->service($wdsl); | |||
|
45 | ||||
|
46 | my $projects = $service->Projects(''); | |||
|
47 | my $project_count = @{$projects}; | |||
|
48 | Log(level => 1, text => "retrieved $project_count projects"); | |||
|
49 | ||||
|
50 | foreach my $project (@{$projects}) { | |||
|
51 | Log(level => 1, text => "treating project $project->{name}"); | |||
|
52 | my $repos_name = $project->{identifier}; | |||
|
53 | ||||
|
54 | if ($repos_name eq "") { | |||
|
55 | Log(text => "\tno identifier for project $project->{name}"); | |||
|
56 | next; | |||
|
57 | } | |||
|
58 | ||||
|
59 | unless ($repos_name =~ /^[a-z0-9\-]+$/) { | |||
|
60 | Log(text => "\tinvalid identifier for project $project->{name}"); | |||
|
61 | next; | |||
|
62 | } | |||
|
63 | ||||
|
64 | my $repos_path = "$repos_base/$repos_name"; | |||
|
65 | ||||
|
66 | if (-e $repos_path) { | |||
|
67 | # check unix right and change them if needed | |||
|
68 | my $other_read = (stat($repos_path))[2] & 00007; | |||
|
69 | my $right; | |||
|
70 | ||||
|
71 | if ($project->{is_public} and not $other_read) { | |||
|
72 | $right = "0775"; | |||
|
73 | } elsif (not $project->{is_public} and $other_read) { | |||
|
74 | $right = "0770"; | |||
|
75 | } else { | |||
|
76 | next; | |||
|
77 | } | |||
|
78 | ||||
|
79 | # change mode | |||
|
80 | system('chmod', '-R', $right, $repos_path) == 0 or | |||
|
81 | warn("\tunable to change mode on $repos_path : $?\n"), next; | |||
|
82 | ||||
|
83 | Log(text => "\tmode change on $repos_path"); | |||
|
84 | ||||
|
85 | } else { | |||
|
86 | # change umask to suit the repository's privacy | |||
|
87 | $project->{is_public} ? umask 0002 : umask 0007; | |||
|
88 | ||||
|
89 | # create the repository | |||
|
90 | system('svnadmin', 'create', $repos_path) == 0 or | |||
|
91 | warn("\tsystem svnadmin failed unable to create $repos_path\n"), next; | |||
|
92 | ||||
|
93 | # set the group owner | |||
|
94 | system('chown', '-R', "root:$repos_name", $repos_path) == 0 or | |||
|
95 | warn("\tunable to create $repos_path : $?\n"), next; | |||
|
96 | ||||
|
97 | Log(text => "\trepository $repos_path created"); | |||
|
98 | my $call = $service->RepositoryCreated($project->{id}, "svn://host/$repos_name"); | |||
|
99 | } | |||
|
100 | } | |||
|
101 | ||||
|
102 | ||||
|
103 | sub Log { | |||
|
104 | my %args = (level => 0, text => '', @_); | |||
|
105 | ||||
|
106 | my $level = delete $args{level}; | |||
|
107 | my $text = delete $args{text}; | |||
|
108 | return unless $level <= $opts{verbose}; | |||
|
109 | return if $opts{quiet}; | |||
|
110 | print "$text\n"; | |||
|
111 | ||||
|
112 | exit $args{exit} | |||
|
113 | if defined $args{exit}; | |||
|
114 | } | |||
|
115 | ||||
|
116 | ||||
|
117 | __END__ | |||
|
118 | ||||
|
119 | =head1 NAME | |||
|
120 | ||||
|
121 | reposman - manages your svn repositories with redMine | |||
|
122 | ||||
|
123 | =head1 SYNOPSIS | |||
|
124 | ||||
|
125 | reposman [options] arguments | |||
|
126 | example: reposman --svn-dir=/var/svn --redmine-host=redmine.mydomain.foo | |||
|
127 | reposman -s /var/svn -r redmine.mydomain.foo | |||
|
128 | ||||
|
129 | =head1 ARGUMENTS | |||
|
130 | ||||
|
131 | -s, --svn-dir=DIR use DIR as base directory for svn repositories | |||
|
132 | -r, --redmine-host=HOST assume redMine is hosted on HOST | |||
|
133 | ||||
|
134 | =head1 OPTIONS | |||
|
135 | ||||
|
136 | -v verbose | |||
|
137 | -V print version and exit | |||
|
138 |
General Comments 0
You need to be logged in to leave comments.
Login now