To check out this repository please hg clone the following URL, or open the URL using EasyMercurial or your preferred Mercurial client.

Statistics Download as Zip
| Branch: | Tag: | Revision:

root / extra / soundsoftware @ 1563:171c31a5cca4

1 7:3c16ed8faa07 Chris
package Apache::Authn::SoundSoftware;
2
3
=head1 Apache::Authn::SoundSoftware
4
5
SoundSoftware - a mod_perl module for Apache authentication against a
6
Redmine database and optional LDAP implementing the access control
7
rules required for the SoundSoftware.ac.uk repository site.
8
9
=head1 SYNOPSIS
10
11
This module is closely based on the Redmine.pm authentication module
12
provided with Redmine.  It is intended to be used for authentication
13
in front of a repository service such as hgwebdir.
14
15
Requirements:
16
17
1. Clone/pull from repo for public project: Any user, no
18
authentication required
19
20
2. Clone/pull from repo for private project: Project members only
21
22
3. Push to repo for public project: "Permitted" users only (this
23 8:0c83d98252d9 Chris
probably means project members who are also identified in the hgrc web
24
section for the repository and so will be approved by hgwebdir?)
25 7:3c16ed8faa07 Chris
26 8:0c83d98252d9 Chris
4. Push to repo for private project: "Permitted" users only (as above)
27 7:3c16ed8faa07 Chris
28 300:034e9b00b341 chris
5. Push to any repo that is tracking an external repo: Refused always
29
30 7:3c16ed8faa07 Chris
=head1 INSTALLATION
31
32
Debian/ubuntu:
33
34
  apt-get install libapache-dbi-perl libapache2-mod-perl2 \
35
    libdbd-mysql-perl libauthen-simple-ldap-perl libio-socket-ssl-perl
36
37
Note that LDAP support is hardcoded "on" in this script (it is
38
optional in the original Redmine.pm).
39
40
=head1 CONFIGURATION
41
42
   ## This module has to be in your perl path
43
   ## eg:  /usr/local/lib/site_perl/Apache/Authn/SoundSoftware.pm
44
   PerlLoadModule Apache::Authn::SoundSoftware
45
46
   # Example when using hgwebdir
47
   ScriptAlias / "/var/hg/hgwebdir.cgi/"
48
49
   <Location />
50
       AuthName "Mercurial"
51
       AuthType Basic
52
       Require valid-user
53
       PerlAccessHandler Apache::Authn::SoundSoftware::access_handler
54
       PerlAuthenHandler Apache::Authn::SoundSoftware::authen_handler
55
       SoundSoftwareDSN "DBI:mysql:database=redmine;host=localhost"
56
       SoundSoftwareDbUser "redmine"
57
       SoundSoftwareDbPass "password"
58
       Options +ExecCGI
59
       AddHandler cgi-script .cgi
60
       ## Optional where clause (fulltext search would be slow and
61
       ## database dependant).
62
       # SoundSoftwareDbWhereClause "and members.role_id IN (1,2)"
63 8:0c83d98252d9 Chris
       ## Optional prefix for local repository URLs
64
       # SoundSoftwareRepoPrefix "/var/hg/"
65 7:3c16ed8faa07 Chris
  </Location>
66
67
See the original Redmine.pm for further configuration notes.
68
69
=cut
70
71
use strict;
72
use warnings FATAL => 'all', NONFATAL => 'redefine';
73
74
use DBI;
75
use Digest::SHA1;
76
use Authen::Simple::LDAP;
77
use Apache2::Module;
78
use Apache2::Access;
79
use Apache2::ServerRec qw();
80
use Apache2::RequestRec qw();
81
use Apache2::RequestUtil qw();
82
use Apache2::Const qw(:common :override :cmd_how);
83
use APR::Pool ();
84
use APR::Table ();
85
86
my @directives = (
87
  {
88
    name => 'SoundSoftwareDSN',
89
    req_override => OR_AUTHCFG,
90
    args_how => TAKE1,
91
    errmsg => 'Dsn in format used by Perl DBI. eg: "DBI:Pg:dbname=databasename;host=my.db.server"',
92
  },
93
  {
94
    name => 'SoundSoftwareDbUser',
95
    req_override => OR_AUTHCFG,
96
    args_how => TAKE1,
97
  },
98
  {
99
    name => 'SoundSoftwareDbPass',
100
    req_override => OR_AUTHCFG,
101
    args_how => TAKE1,
102
  },
103
  {
104
    name => 'SoundSoftwareDbWhereClause',
105
    req_override => OR_AUTHCFG,
106
    args_how => TAKE1,
107
  },
108
  {
109 8:0c83d98252d9 Chris
    name => 'SoundSoftwareRepoPrefix',
110 7:3c16ed8faa07 Chris
    req_override => OR_AUTHCFG,
111
    args_how => TAKE1,
112
  },
113
);
114
115
sub SoundSoftwareDSN {
116 8:0c83d98252d9 Chris
    my ($self, $parms, $arg) = @_;
117
    $self->{SoundSoftwareDSN} = $arg;
118
    my $query = "SELECT
119 7:3c16ed8faa07 Chris
                 hashed_password, auth_source_id, permissions
120
              FROM members, projects, users, roles, member_roles
121
              WHERE
122
                projects.id=members.project_id
123
                AND member_roles.member_id=members.id
124
                AND users.id=members.user_id
125
                AND roles.id=member_roles.role_id
126
                AND users.status=1
127
                AND login=?
128
                AND identifier=? ";
129 8:0c83d98252d9 Chris
    $self->{SoundSoftwareQuery} = trim($query);
130 7:3c16ed8faa07 Chris
}
131
132
sub SoundSoftwareDbUser { set_val('SoundSoftwareDbUser', @_); }
133
sub SoundSoftwareDbPass { set_val('SoundSoftwareDbPass', @_); }
134
sub SoundSoftwareDbWhereClause {
135 8:0c83d98252d9 Chris
    my ($self, $parms, $arg) = @_;
136
    $self->{SoundSoftwareQuery} = trim($self->{SoundSoftwareQuery}.($arg ? $arg : "")." ");
137 7:3c16ed8faa07 Chris
}
138
139 8:0c83d98252d9 Chris
sub SoundSoftwareRepoPrefix {
140
    my ($self, $parms, $arg) = @_;
141
    if ($arg) {
142
	$self->{SoundSoftwareRepoPrefix} = $arg;
143
    }
144 7:3c16ed8faa07 Chris
}
145
146
sub trim {
147 8:0c83d98252d9 Chris
    my $string = shift;
148
    $string =~ s/\s{2,}/ /g;
149
    return $string;
150 7:3c16ed8faa07 Chris
}
151
152
sub set_val {
153 8:0c83d98252d9 Chris
    my ($key, $self, $parms, $arg) = @_;
154
    $self->{$key} = $arg;
155 7:3c16ed8faa07 Chris
}
156
157
Apache2::Module::add(__PACKAGE__, \@directives);
158
159
160
my %read_only_methods = map { $_ => 1 } qw/GET PROPFIND REPORT OPTIONS/;
161
162
sub access_handler {
163 8:0c83d98252d9 Chris
    my $r = shift;
164 7:3c16ed8faa07 Chris
165 152:a389c77da9fd Chris
    print STDERR "SoundSoftware.pm: In access handler at " . scalar localtime() . "\n";
166 7:3c16ed8faa07 Chris
167 8:0c83d98252d9 Chris
    unless ($r->some_auth_required) {
168
	$r->log_reason("No authentication has been configured");
169
	return FORBIDDEN;
170
    }
171 7:3c16ed8faa07 Chris
172 8:0c83d98252d9 Chris
    my $method = $r->method;
173 7:3c16ed8faa07 Chris
174 8:0c83d98252d9 Chris
    print STDERR "SoundSoftware.pm: Method: $method, uri " . $r->uri . ", location " . $r->location . "\n";
175
    print STDERR "SoundSoftware.pm: Accept: " . $r->headers_in->{Accept} . "\n";
176 7:3c16ed8faa07 Chris
177 8:0c83d98252d9 Chris
    my $dbh = connect_database($r);
178 152:a389c77da9fd Chris
    unless ($dbh) {
179
	print STDERR "SoundSoftware.pm: Database connection failed!: " . $DBI::errstr . "\n";
180
	return FORBIDDEN;
181
    }
182
183 300:034e9b00b341 chris
    print STDERR "Connected to db, dbh is " . $dbh . "\n";
184 7:3c16ed8faa07 Chris
185 8:0c83d98252d9 Chris
    my $project_id = get_project_identifier($dbh, $r);
186 300:034e9b00b341 chris
187
    if (!defined $read_only_methods{$method}) {
188
        print STDERR "SoundSoftware.pm: Method is not read-only\n";
189
        if (project_repo_is_readonly($dbh, $project_id, $r)) {
190
            print STDERR "SoundSoftware.pm: Project repo is read-only, refusing access\n";
191
	    return FORBIDDEN;
192
        } else {
193
	    print STDERR "SoundSoftware.pm: Project repo is read-write, authentication handler required\n";
194
            return OK;
195
        }
196
    }
197
198 8:0c83d98252d9 Chris
    my $status = get_project_status($dbh, $project_id, $r);
199 7:3c16ed8faa07 Chris
200 8:0c83d98252d9 Chris
    $dbh->disconnect();
201
    undef $dbh;
202 7:3c16ed8faa07 Chris
203 8:0c83d98252d9 Chris
    if ($status == 0) { # nonexistent
204
	print STDERR "SoundSoftware.pm: Project does not exist, refusing access\n";
205
	return FORBIDDEN;
206
    } elsif ($status == 1) { # public
207
	print STDERR "SoundSoftware.pm: Project is public, no restriction here\n";
208
	$r->set_handlers(PerlAuthenHandler => [\&OK])
209
    } else { # private
210
	print STDERR "SoundSoftware.pm: Project is private, authentication handler required\n";
211
    }
212 7:3c16ed8faa07 Chris
213 8:0c83d98252d9 Chris
    return OK
214 7:3c16ed8faa07 Chris
}
215
216
sub authen_handler {
217 8:0c83d98252d9 Chris
    my $r = shift;
218
219 152:a389c77da9fd Chris
    print STDERR "SoundSoftware.pm: In authentication handler at " . scalar localtime() . "\n";
220 7:3c16ed8faa07 Chris
221 8:0c83d98252d9 Chris
    my $dbh = connect_database($r);
222 152:a389c77da9fd Chris
    unless ($dbh) {
223
        print STDERR "SoundSoftware.pm: Database connection failed!: " . $DBI::errstr . "\n";
224
        return AUTH_REQUIRED;
225
    }
226 8:0c83d98252d9 Chris
227
    my $project_id = get_project_identifier($dbh, $r);
228
    my $realm = get_realm($dbh, $project_id, $r);
229
    $r->auth_name($realm);
230
231
    my ($res, $redmine_pass) =  $r->get_basic_auth_pw();
232
    unless ($res == OK) {
233
	$dbh->disconnect();
234
	undef $dbh;
235
	return $res;
236
    }
237
238
    print STDERR "SoundSoftware.pm: User is " . $r->user . ", got password\n";
239
240
    my $permitted = is_permitted($dbh, $project_id, $r->user, $redmine_pass, $r);
241
242
    $dbh->disconnect();
243
    undef $dbh;
244
245
    if ($permitted) {
246
	return OK;
247
    } else {
248
	print STDERR "SoundSoftware.pm: Not permitted\n";
249
	$r->note_auth_failure();
250
	return AUTH_REQUIRED;
251
    }
252 7:3c16ed8faa07 Chris
}
253
254
sub get_project_status {
255 8:0c83d98252d9 Chris
    my $dbh = shift;
256 7:3c16ed8faa07 Chris
    my $project_id = shift;
257
    my $r = shift;
258 8:0c83d98252d9 Chris
259
    if (!defined $project_id or $project_id eq '') {
260
	return 0; # nonexistent
261
    }
262 7:3c16ed8faa07 Chris
263
    my $sth = $dbh->prepare(
264
        "SELECT is_public FROM projects WHERE projects.identifier = ?;"
265
    );
266
267
    $sth->execute($project_id);
268 8:0c83d98252d9 Chris
    my $ret = 0; # nonexistent
269 7:3c16ed8faa07 Chris
    if (my @row = $sth->fetchrow_array) {
270
    	if ($row[0] eq "1" || $row[0] eq "t") {
271
	    $ret = 1; # public
272
    	} else {
273 8:0c83d98252d9 Chris
	    $ret = 2; # private
274 7:3c16ed8faa07 Chris
	}
275
    }
276
    $sth->finish();
277
    undef $sth;
278
279
    $ret;
280
}
281
282 300:034e9b00b341 chris
sub project_repo_is_readonly {
283
    my $dbh = shift;
284
    my $project_id = shift;
285
    my $r = shift;
286
287
    if (!defined $project_id or $project_id eq '') {
288
        return 0; # nonexistent
289
    }
290
291
    my $sth = $dbh->prepare(
292
        "SELECT repositories.is_external FROM repositories, projects WHERE projects.identifier = ? AND repositories.project_id = projects.id;"
293
    );
294
295
    $sth->execute($project_id);
296
    my $ret = 0; # nonexistent
297
    if (my @row = $sth->fetchrow_array) {
298 301:6d3f8aeb51b7 chris
        if (defined($row[0]) && ($row[0] eq "1" || $row[0] eq "t")) {
299 300:034e9b00b341 chris
            $ret = 1; # read-only (i.e. external)
300
        } else {
301
            $ret = 0; # read-write
302
        }
303
    }
304
    $sth->finish();
305
    undef $sth;
306
307
    $ret;
308
}
309
310 8:0c83d98252d9 Chris
sub is_permitted {
311
    my $dbh = shift;
312
    my $project_id = shift;
313
    my $redmine_user = shift;
314
    my $redmine_pass = shift;
315
    my $r = shift;
316 7:3c16ed8faa07 Chris
317 8:0c83d98252d9 Chris
    my $pass_digest = Digest::SHA1::sha1_hex($redmine_pass);
318 7:3c16ed8faa07 Chris
319 8:0c83d98252d9 Chris
    my $cfg = Apache2::Module::get_config
320
	(__PACKAGE__, $r->server, $r->per_dir_config);
321 7:3c16ed8faa07 Chris
322 8:0c83d98252d9 Chris
    my $query = $cfg->{SoundSoftwareQuery};
323
    my $sth = $dbh->prepare($query);
324
    $sth->execute($redmine_user, $project_id);
325 7:3c16ed8faa07 Chris
326 8:0c83d98252d9 Chris
    my $ret;
327
    while (my ($hashed_password, $auth_source_id, $permissions) = $sth->fetchrow_array) {
328 7:3c16ed8faa07 Chris
329 8:0c83d98252d9 Chris
	# Test permissions for this user before we verify credentials
330
	# -- if the user is not permitted this action anyway, there's
331
	# not much point in e.g. contacting the LDAP
332 7:3c16ed8faa07 Chris
333 8:0c83d98252d9 Chris
	my $method = $r->method;
334 7:3c16ed8faa07 Chris
335 8:0c83d98252d9 Chris
	if ((defined $read_only_methods{$method} && $permissions =~ /:browse_repository/)
336
	    || $permissions =~ /:commit_access/) {
337
338
	    # User would be permitted this action, if their
339
	    # credentials checked out -- test those now
340
341
	    print STDERR "SoundSoftware.pm: User $redmine_user has required role, checking credentials\n";
342
343
	    unless ($auth_source_id) {
344
		if ($hashed_password eq $pass_digest) {
345
		    print STDERR "SoundSoftware.pm: User $redmine_user authenticated via password\n";
346
		    $ret = 1;
347
		    last;
348
		}
349
	    } else {
350
		my $sthldap = $dbh->prepare(
351
		    "SELECT host,port,tls,account,account_password,base_dn,attr_login FROM auth_sources WHERE id = ?;"
352
		    );
353
		$sthldap->execute($auth_source_id);
354
		while (my @rowldap = $sthldap->fetchrow_array) {
355
		    my $ldap = Authen::Simple::LDAP->new(
356
			host    => ($rowldap[2] eq "1" || $rowldap[2] eq "t") ? "ldaps://$rowldap[0]" : $rowldap[0],
357
			port    => $rowldap[1],
358
			basedn  => $rowldap[5],
359
			binddn  => $rowldap[3] ? $rowldap[3] : "",
360
			bindpw  => $rowldap[4] ? $rowldap[4] : "",
361
			filter  => "(".$rowldap[6]."=%s)"
362
			);
363
		    if ($ldap->authenticate($redmine_user, $redmine_pass)) {
364
			print STDERR "SoundSoftware.pm: User $redmine_user authenticated via LDAP\n";
365
			$ret = 1;
366
		    }
367
		}
368
		$sthldap->finish();
369
		undef $sthldap;
370
	    }
371
	} else {
372
	    print STDERR "SoundSoftware.pm: User $redmine_user lacks required role for this project\n";
373
	}
374 7:3c16ed8faa07 Chris
    }
375
376 8:0c83d98252d9 Chris
    $sth->finish();
377
    undef $sth;
378
379
    $ret;
380 7:3c16ed8faa07 Chris
}
381
382
sub get_project_identifier {
383 8:0c83d98252d9 Chris
    my $dbh = shift;
384 7:3c16ed8faa07 Chris
    my $r = shift;
385
386
    my $location = $r->location;
387
    my ($repo) = $r->uri =~ m{$location/*([^/]+)};
388 10:2c10dc5f122d Chris
389
    return $repo if (!$repo);
390
391 7:3c16ed8faa07 Chris
    $repo =~ s/[^a-zA-Z0-9\._-]//g;
392
393 8:0c83d98252d9 Chris
    # The original Redmine.pm returns the string just calculated as
394
    # the project identifier.  That won't do for us -- we may have
395
    # (and in fact already do have, in our test instance) projects
396
    # whose repository names differ from the project identifiers.
397
398
    # This is a rather fundamental change because it means that almost
399
    # every request needs more than one database query -- which
400
    # prompts us to start passing around $dbh instead of connecting
401
    # locally within each function as is done in Redmine.pm.
402
403 7:3c16ed8faa07 Chris
    my $sth = $dbh->prepare(
404
        "SELECT projects.identifier FROM projects, repositories WHERE repositories.project_id = projects.id AND repositories.url LIKE ?;"
405
    );
406
407 8:0c83d98252d9 Chris
    my $cfg = Apache2::Module::get_config
408
	(__PACKAGE__, $r->server, $r->per_dir_config);
409
410
    my $prefix = $cfg->{SoundSoftwareRepoPrefix};
411
    if (!defined $prefix) { $prefix = '%/'; }
412
413 7:3c16ed8faa07 Chris
    my $identifier = '';
414
415 8:0c83d98252d9 Chris
    $sth->execute($prefix . $repo);
416 7:3c16ed8faa07 Chris
    my $ret = 0;
417
    if (my @row = $sth->fetchrow_array) {
418
	$identifier = $row[0];
419
    }
420
    $sth->finish();
421
    undef $sth;
422
423 8:0c83d98252d9 Chris
    print STDERR "SoundSoftware.pm: Repository '$repo' belongs to project '$identifier'\n";
424 7:3c16ed8faa07 Chris
425
    $identifier;
426
}
427
428 8:0c83d98252d9 Chris
sub get_realm {
429
    my $dbh = shift;
430
    my $project_id = shift;
431
    my $r = shift;
432
433
    my $sth = $dbh->prepare(
434
        "SELECT projects.name FROM projects WHERE projects.identifier = ?;"
435
    );
436
437
    my $name = $project_id;
438
439
    $sth->execute($project_id);
440
    my $ret = 0;
441
    if (my @row = $sth->fetchrow_array) {
442
	$name = $row[0];
443
    }
444
    $sth->finish();
445
    undef $sth;
446
447
    # be timid about characters not permitted in auth realm and revert
448
    # to project identifier if any are found
449
    if ($name =~ m/[^\w\d\s\._-]/) {
450
	$name = $project_id;
451
    }
452
453
    my $realm = '"Mercurial repository for ' . "'$name'" . '"';
454
455
    $realm;
456
}
457
458 7:3c16ed8faa07 Chris
sub connect_database {
459
    my $r = shift;
460
461 8:0c83d98252d9 Chris
    my $cfg = Apache2::Module::get_config
462
	(__PACKAGE__, $r->server, $r->per_dir_config);
463
464
    return DBI->connect($cfg->{SoundSoftwareDSN},
465 152:a389c77da9fd Chris
	                $cfg->{SoundSoftwareDbUser},
466
		        $cfg->{SoundSoftwareDbPass});
467 7:3c16ed8faa07 Chris
}
468
469
1;
470
package Apache::Authn::SoundSoftware;
471
472
=head1 Apache::Authn::SoundSoftware
473
474
SoundSoftware - a mod_perl module for Apache authentication against a
475
Redmine database and optional LDAP implementing the access control
476
rules required for the SoundSoftware.ac.uk repository site.
477
478
=head1 SYNOPSIS
479
480
This module is closely based on the Redmine.pm authentication module
481
provided with Redmine.  It is intended to be used for authentication
482
in front of a repository service such as hgwebdir.
483
484
Requirements:
485
486
1. Clone/pull from repo for public project: Any user, no
487
authentication required
488
489
2. Clone/pull from repo for private project: Project members only
490
491
3. Push to repo for public project: "Permitted" users only (this
492 8:0c83d98252d9 Chris
probably means project members who are also identified in the hgrc web
493
section for the repository and so will be approved by hgwebdir?)
494 7:3c16ed8faa07 Chris
495 8:0c83d98252d9 Chris
4. Push to repo for private project: "Permitted" users only (as above)
496 7:3c16ed8faa07 Chris
497 300:034e9b00b341 chris
5. Push to any repo that is tracking an external repo: Refused always
498
499 7:3c16ed8faa07 Chris
=head1 INSTALLATION
500
501
Debian/ubuntu:
502
503
  apt-get install libapache-dbi-perl libapache2-mod-perl2 \
504
    libdbd-mysql-perl libauthen-simple-ldap-perl libio-socket-ssl-perl
505
506
Note that LDAP support is hardcoded "on" in this script (it is
507
optional in the original Redmine.pm).
508
509
=head1 CONFIGURATION
510
511
   ## This module has to be in your perl path
512
   ## eg:  /usr/local/lib/site_perl/Apache/Authn/SoundSoftware.pm
513
   PerlLoadModule Apache::Authn::SoundSoftware
514
515
   # Example when using hgwebdir
516
   ScriptAlias / "/var/hg/hgwebdir.cgi/"
517
518
   <Location />
519
       AuthName "Mercurial"
520
       AuthType Basic
521
       Require valid-user
522
       PerlAccessHandler Apache::Authn::SoundSoftware::access_handler
523
       PerlAuthenHandler Apache::Authn::SoundSoftware::authen_handler
524
       SoundSoftwareDSN "DBI:mysql:database=redmine;host=localhost"
525
       SoundSoftwareDbUser "redmine"
526
       SoundSoftwareDbPass "password"
527
       Options +ExecCGI
528
       AddHandler cgi-script .cgi
529
       ## Optional where clause (fulltext search would be slow and
530
       ## database dependant).
531
       # SoundSoftwareDbWhereClause "and members.role_id IN (1,2)"
532 8:0c83d98252d9 Chris
       ## Optional prefix for local repository URLs
533
       # SoundSoftwareRepoPrefix "/var/hg/"
534 7:3c16ed8faa07 Chris
  </Location>
535
536
See the original Redmine.pm for further configuration notes.
537
538
=cut
539
540
use strict;
541
use warnings FATAL => 'all', NONFATAL => 'redefine';
542
543
use DBI;
544 1331:1e9b1bdd062e Chris
use Digest::SHA;
545 7:3c16ed8faa07 Chris
use Authen::Simple::LDAP;
546
use Apache2::Module;
547
use Apache2::Access;
548
use Apache2::ServerRec qw();
549
use Apache2::RequestRec qw();
550
use Apache2::RequestUtil qw();
551
use Apache2::Const qw(:common :override :cmd_how);
552
use APR::Pool ();
553
use APR::Table ();
554
555
my @directives = (
556
  {
557
    name => 'SoundSoftwareDSN',
558
    req_override => OR_AUTHCFG,
559
    args_how => TAKE1,
560
    errmsg => 'Dsn in format used by Perl DBI. eg: "DBI:Pg:dbname=databasename;host=my.db.server"',
561
  },
562
  {
563
    name => 'SoundSoftwareDbUser',
564
    req_override => OR_AUTHCFG,
565
    args_how => TAKE1,
566
  },
567
  {
568
    name => 'SoundSoftwareDbPass',
569
    req_override => OR_AUTHCFG,
570
    args_how => TAKE1,
571
  },
572
  {
573
    name => 'SoundSoftwareDbWhereClause',
574
    req_override => OR_AUTHCFG,
575
    args_how => TAKE1,
576
  },
577
  {
578 8:0c83d98252d9 Chris
    name => 'SoundSoftwareRepoPrefix',
579 7:3c16ed8faa07 Chris
    req_override => OR_AUTHCFG,
580
    args_how => TAKE1,
581
  },
582 732:897bc2b63bfe Chris
  {
583
    name => 'SoundSoftwareSslRequired',
584
    req_override => OR_AUTHCFG,
585
    args_how => TAKE1,
586
  },
587 7:3c16ed8faa07 Chris
);
588
589
sub SoundSoftwareDSN {
590 8:0c83d98252d9 Chris
    my ($self, $parms, $arg) = @_;
591
    $self->{SoundSoftwareDSN} = $arg;
592
    my $query = "SELECT
593 301:6d3f8aeb51b7 chris
                 hashed_password, salt, auth_source_id, permissions
594 7:3c16ed8faa07 Chris
              FROM members, projects, users, roles, member_roles
595
              WHERE
596
                projects.id=members.project_id
597
                AND member_roles.member_id=members.id
598
                AND users.id=members.user_id
599
                AND roles.id=member_roles.role_id
600
                AND users.status=1
601
                AND login=?
602
                AND identifier=? ";
603 8:0c83d98252d9 Chris
    $self->{SoundSoftwareQuery} = trim($query);
604 7:3c16ed8faa07 Chris
}
605
606
sub SoundSoftwareDbUser { set_val('SoundSoftwareDbUser', @_); }
607
sub SoundSoftwareDbPass { set_val('SoundSoftwareDbPass', @_); }
608
sub SoundSoftwareDbWhereClause {
609 8:0c83d98252d9 Chris
    my ($self, $parms, $arg) = @_;
610
    $self->{SoundSoftwareQuery} = trim($self->{SoundSoftwareQuery}.($arg ? $arg : "")." ");
611 7:3c16ed8faa07 Chris
}
612
613 8:0c83d98252d9 Chris
sub SoundSoftwareRepoPrefix {
614
    my ($self, $parms, $arg) = @_;
615
    if ($arg) {
616
	$self->{SoundSoftwareRepoPrefix} = $arg;
617
    }
618 7:3c16ed8faa07 Chris
}
619
620 732:897bc2b63bfe Chris
sub SoundSoftwareSslRequired { set_val('SoundSoftwareSslRequired', @_); }
621
622 7:3c16ed8faa07 Chris
sub trim {
623 8:0c83d98252d9 Chris
    my $string = shift;
624
    $string =~ s/\s{2,}/ /g;
625
    return $string;
626 7:3c16ed8faa07 Chris
}
627
628
sub set_val {
629 8:0c83d98252d9 Chris
    my ($key, $self, $parms, $arg) = @_;
630
    $self->{$key} = $arg;
631 7:3c16ed8faa07 Chris
}
632
633
Apache2::Module::add(__PACKAGE__, \@directives);
634
635
636
my %read_only_methods = map { $_ => 1 } qw/GET PROPFIND REPORT OPTIONS/;
637
638
sub access_handler {
639 8:0c83d98252d9 Chris
    my $r = shift;
640 7:3c16ed8faa07 Chris
641 517:bd1d512f9e1b Chris
    print STDERR "SoundSoftware.pm:$$: In access handler at " . scalar localtime() . "\n";
642 7:3c16ed8faa07 Chris
643 8:0c83d98252d9 Chris
    unless ($r->some_auth_required) {
644
	$r->log_reason("No authentication has been configured");
645
	return FORBIDDEN;
646
    }
647 7:3c16ed8faa07 Chris
648 8:0c83d98252d9 Chris
    my $method = $r->method;
649 7:3c16ed8faa07 Chris
650 517:bd1d512f9e1b Chris
    print STDERR "SoundSoftware.pm:$$: Method: $method, uri " . $r->uri . ", location " . $r->location . "\n";
651
    print STDERR "SoundSoftware.pm:$$: Accept: " . $r->headers_in->{Accept} . "\n";
652 7:3c16ed8faa07 Chris
653 8:0c83d98252d9 Chris
    my $dbh = connect_database($r);
654 152:a389c77da9fd Chris
    unless ($dbh) {
655 517:bd1d512f9e1b Chris
	print STDERR "SoundSoftware.pm:$$: Database connection failed!: " . $DBI::errstr . "\n";
656 152:a389c77da9fd Chris
	return FORBIDDEN;
657
    }
658
659 300:034e9b00b341 chris
    print STDERR "Connected to db, dbh is " . $dbh . "\n";
660 7:3c16ed8faa07 Chris
661 8:0c83d98252d9 Chris
    my $project_id = get_project_identifier($dbh, $r);
662 300:034e9b00b341 chris
663 732:897bc2b63bfe Chris
    # We want to delegate most of the work to the authentication
664
    # handler (to ensure that user is asked to login even for
665
    # nonexistent projects -- so they can't tell whether a private
666
    # project exists or not without authenticating). So
667
    #
668
    # * if the project is public
669
    #   - if the method is read-only
670
    #     + set handler to OK, no auth needed
671
    #   - if the method is not read-only
672
    #     + if the repo is read-only, return forbidden
673
    #     + else require auth
674
    # * if the project is not public or does not exist
675
    #     + require auth
676
    #
677
    # If we are requiring auth and are not currently https, and
678
    # https is required, then we must return a redirect to https
679
    # instead of an OK.
680 300:034e9b00b341 chris
681 8:0c83d98252d9 Chris
    my $status = get_project_status($dbh, $project_id, $r);
682 732:897bc2b63bfe Chris
    my $readonly = project_repo_is_readonly($dbh, $project_id, $r);
683 7:3c16ed8faa07 Chris
684 8:0c83d98252d9 Chris
    $dbh->disconnect();
685
    undef $dbh;
686 7:3c16ed8faa07 Chris
687 734:1d1b8170c2f7 Chris
    my $auth_ssl_reqd = will_require_ssl_auth($r);
688
689 732:897bc2b63bfe Chris
    if ($status == 1) { # public
690
691
	print STDERR "SoundSoftware.pm:$$: Project is public\n";
692
693
	if (!defined $read_only_methods{$method}) {
694
695
	    print STDERR "SoundSoftware.pm:$$: Method is not read-only\n";
696
697
	    if ($readonly) {
698
		print STDERR "SoundSoftware.pm:$$: Project repo is read-only, refusing access\n";
699
		return FORBIDDEN;
700
	    } else {
701
		print STDERR "SoundSoftware.pm:$$: Project repo is read-write, auth required\n";
702
		# fall through, this is the normal case
703
	    }
704
705 734:1d1b8170c2f7 Chris
        } elsif ($auth_ssl_reqd and $r->unparsed_uri =~ m/cmd=branchmap/) {
706
707
            # A hac^H^H^Hspecial case. We want to ensure we switch to
708
            # https (if it will be necessarily for authentication)
709
            # before the first POST request, and this is what I think
710
            # will give us suitable warning for Mercurial.
711
712
            print STDERR "SoundSoftware.pm:$$: Switching to HTTPS in preparation\n";
713
            # fall through, this is the normal case
714
715 732:897bc2b63bfe Chris
	} else {
716
	    # Public project, read-only method -- this is the only
717
	    # case we can decide for certain to accept in this function
718
	    print STDERR "SoundSoftware.pm:$$: Method is read-only, no restriction here\n";
719
	    $r->set_handlers(PerlAuthenHandler => [\&OK]);
720
	    return OK;
721
	}
722
723
    } else { # status != 1, i.e. nonexistent or private -- equivalent here
724
725
	print STDERR "SoundSoftware.pm:$$: Project is private or nonexistent, auth required\n";
726
	# fall through
727 8:0c83d98252d9 Chris
    }
728 7:3c16ed8faa07 Chris
729 734:1d1b8170c2f7 Chris
    if ($auth_ssl_reqd) {
730
        my $redir_to = "https://" . $r->hostname() . $r->unparsed_uri();
731
        print STDERR "SoundSoftware.pm:$$: Need to switch to HTTPS, redirecting to $redir_to\n";
732
        $r->headers_out->add('Location' => $redir_to);
733
        return REDIRECT;
734 732:897bc2b63bfe Chris
    } else {
735 734:1d1b8170c2f7 Chris
        return OK;
736 732:897bc2b63bfe Chris
    }
737 7:3c16ed8faa07 Chris
}
738
739
sub authen_handler {
740 8:0c83d98252d9 Chris
    my $r = shift;
741
742 517:bd1d512f9e1b Chris
    print STDERR "SoundSoftware.pm:$$: In authentication handler at " . scalar localtime() . "\n";
743 7:3c16ed8faa07 Chris
744 8:0c83d98252d9 Chris
    my $dbh = connect_database($r);
745 152:a389c77da9fd Chris
    unless ($dbh) {
746 517:bd1d512f9e1b Chris
        print STDERR "SoundSoftware.pm:$$: Database connection failed!: " . $DBI::errstr . "\n";
747 152:a389c77da9fd Chris
        return AUTH_REQUIRED;
748
    }
749 8:0c83d98252d9 Chris
750
    my $project_id = get_project_identifier($dbh, $r);
751
    my $realm = get_realm($dbh, $project_id, $r);
752
    $r->auth_name($realm);
753
754
    my ($res, $redmine_pass) =  $r->get_basic_auth_pw();
755
    unless ($res == OK) {
756
	$dbh->disconnect();
757
	undef $dbh;
758
	return $res;
759
    }
760
761 517:bd1d512f9e1b Chris
    print STDERR "SoundSoftware.pm:$$: User is " . $r->user . ", got password\n";
762 8:0c83d98252d9 Chris
763 732:897bc2b63bfe Chris
    my $status = get_project_status($dbh, $project_id, $r);
764
    if ($status == 0) {
765
	# nonexistent, behave like private project you aren't a member of
766
	print STDERR "SoundSoftware.pm:$$: Project doesn't exist, not permitted\n";
767
	$dbh->disconnect();
768
	undef $dbh;
769
	$r->note_auth_failure();
770
	return AUTH_REQUIRED;
771
    }
772
773 8:0c83d98252d9 Chris
    my $permitted = is_permitted($dbh, $project_id, $r->user, $redmine_pass, $r);
774
775
    $dbh->disconnect();
776
    undef $dbh;
777
778
    if ($permitted) {
779
	return OK;
780
    } else {
781 517:bd1d512f9e1b Chris
	print STDERR "SoundSoftware.pm:$$: Not permitted\n";
782 8:0c83d98252d9 Chris
	$r->note_auth_failure();
783
	return AUTH_REQUIRED;
784
    }
785 7:3c16ed8faa07 Chris
}
786
787
sub get_project_status {
788 8:0c83d98252d9 Chris
    my $dbh = shift;
789 7:3c16ed8faa07 Chris
    my $project_id = shift;
790
    my $r = shift;
791 8:0c83d98252d9 Chris
792
    if (!defined $project_id or $project_id eq '') {
793
	return 0; # nonexistent
794
    }
795 7:3c16ed8faa07 Chris
796
    my $sth = $dbh->prepare(
797
        "SELECT is_public FROM projects WHERE projects.identifier = ?;"
798
    );
799
800
    $sth->execute($project_id);
801 8:0c83d98252d9 Chris
    my $ret = 0; # nonexistent
802 7:3c16ed8faa07 Chris
    if (my @row = $sth->fetchrow_array) {
803
    	if ($row[0] eq "1" || $row[0] eq "t") {
804
	    $ret = 1; # public
805
    	} else {
806 8:0c83d98252d9 Chris
	    $ret = 2; # private
807 7:3c16ed8faa07 Chris
	}
808
    }
809
    $sth->finish();
810
    undef $sth;
811
812
    $ret;
813
}
814
815 734:1d1b8170c2f7 Chris
sub will_require_ssl_auth {
816
    my $r = shift;
817
818
    my $cfg = Apache2::Module::get_config
819
        (__PACKAGE__, $r->server, $r->per_dir_config);
820
821
    if ($cfg->{SoundSoftwareSslRequired} eq "on") {
822
        if ($r->dir_config('HTTPS') eq "on") {
823
            # already have ssl
824
            return 0;
825
        } else {
826
            # require ssl for auth, don't have it yet
827
            return 1;
828
        }
829
    } elsif ($cfg->{SoundSoftwareSslRequired} eq "off") {
830
        # don't require ssl for auth
831
        return 0;
832
    } else {
833
        print STDERR "WARNING: SoundSoftware.pm:$$: SoundSoftwareSslRequired should be either 'on' or 'off'\n";
834
        # this is safer
835
        return 1;
836
    }
837
}
838
839 300:034e9b00b341 chris
sub project_repo_is_readonly {
840
    my $dbh = shift;
841
    my $project_id = shift;
842
    my $r = shift;
843
844
    if (!defined $project_id or $project_id eq '') {
845
        return 0; # nonexistent
846
    }
847
848
    my $sth = $dbh->prepare(
849
        "SELECT repositories.is_external FROM repositories, projects WHERE projects.identifier = ? AND repositories.project_id = projects.id;"
850
    );
851
852
    $sth->execute($project_id);
853
    my $ret = 0; # nonexistent
854
    if (my @row = $sth->fetchrow_array) {
855 301:6d3f8aeb51b7 chris
        if (defined($row[0]) && ($row[0] eq "1" || $row[0] eq "t")) {
856 300:034e9b00b341 chris
            $ret = 1; # read-only (i.e. external)
857
        } else {
858
            $ret = 0; # read-write
859
        }
860
    }
861
    $sth->finish();
862
    undef $sth;
863
864
    $ret;
865
}
866
867 8:0c83d98252d9 Chris
sub is_permitted {
868
    my $dbh = shift;
869
    my $project_id = shift;
870
    my $redmine_user = shift;
871
    my $redmine_pass = shift;
872
    my $r = shift;
873 7:3c16ed8faa07 Chris
874 1331:1e9b1bdd062e Chris
    my $pass_digest = Digest::SHA::sha1_hex($redmine_pass);
875 7:3c16ed8faa07 Chris
876 8:0c83d98252d9 Chris
    my $cfg = Apache2::Module::get_config
877
	(__PACKAGE__, $r->server, $r->per_dir_config);
878 7:3c16ed8faa07 Chris
879 8:0c83d98252d9 Chris
    my $query = $cfg->{SoundSoftwareQuery};
880
    my $sth = $dbh->prepare($query);
881
    $sth->execute($redmine_user, $project_id);
882 7:3c16ed8faa07 Chris
883 8:0c83d98252d9 Chris
    my $ret;
884 301:6d3f8aeb51b7 chris
    while (my ($hashed_password, $salt, $auth_source_id, $permissions) = $sth->fetchrow_array) {
885 7:3c16ed8faa07 Chris
886 8:0c83d98252d9 Chris
	# Test permissions for this user before we verify credentials
887
	# -- if the user is not permitted this action anyway, there's
888
	# not much point in e.g. contacting the LDAP
889 7:3c16ed8faa07 Chris
890 8:0c83d98252d9 Chris
	my $method = $r->method;
891 7:3c16ed8faa07 Chris
892 8:0c83d98252d9 Chris
	if ((defined $read_only_methods{$method} && $permissions =~ /:browse_repository/)
893
	    || $permissions =~ /:commit_access/) {
894
895
	    # User would be permitted this action, if their
896
	    # credentials checked out -- test those now
897
898
	    print STDERR "SoundSoftware.pm: User $redmine_user has required role, checking credentials\n";
899
900
	    unless ($auth_source_id) {
901 1331:1e9b1bdd062e Chris
                my $salted_password = Digest::SHA::sha1_hex($salt.$pass_digest);
902 301:6d3f8aeb51b7 chris
		if ($hashed_password eq $salted_password) {
903 8:0c83d98252d9 Chris
		    print STDERR "SoundSoftware.pm: User $redmine_user authenticated via password\n";
904
		    $ret = 1;
905
		    last;
906
		}
907
	    } else {
908
		my $sthldap = $dbh->prepare(
909
		    "SELECT host,port,tls,account,account_password,base_dn,attr_login FROM auth_sources WHERE id = ?;"
910
		    );
911
		$sthldap->execute($auth_source_id);
912
		while (my @rowldap = $sthldap->fetchrow_array) {
913
		    my $ldap = Authen::Simple::LDAP->new(
914
			host    => ($rowldap[2] eq "1" || $rowldap[2] eq "t") ? "ldaps://$rowldap[0]" : $rowldap[0],
915
			port    => $rowldap[1],
916
			basedn  => $rowldap[5],
917
			binddn  => $rowldap[3] ? $rowldap[3] : "",
918
			bindpw  => $rowldap[4] ? $rowldap[4] : "",
919
			filter  => "(".$rowldap[6]."=%s)"
920
			);
921
		    if ($ldap->authenticate($redmine_user, $redmine_pass)) {
922 517:bd1d512f9e1b Chris
			print STDERR "SoundSoftware.pm:$$: User $redmine_user authenticated via LDAP\n";
923 8:0c83d98252d9 Chris
			$ret = 1;
924
		    }
925
		}
926
		$sthldap->finish();
927
		undef $sthldap;
928 735:8653bddf26a6 Chris
                last if ($ret);
929 8:0c83d98252d9 Chris
	    }
930
	} else {
931 517:bd1d512f9e1b Chris
	    print STDERR "SoundSoftware.pm:$$: User $redmine_user lacks required role for this project\n";
932 8:0c83d98252d9 Chris
	}
933 7:3c16ed8faa07 Chris
    }
934
935 8:0c83d98252d9 Chris
    $sth->finish();
936
    undef $sth;
937
938
    $ret;
939 7:3c16ed8faa07 Chris
}
940
941
sub get_project_identifier {
942 8:0c83d98252d9 Chris
    my $dbh = shift;
943 7:3c16ed8faa07 Chris
    my $r = shift;
944
    my $location = $r->location;
945 737:1ce6efe3db0e Chris
    my ($repo) = $r->uri =~ m{$location/*([^/]*)};
946 10:2c10dc5f122d Chris
947
    return $repo if (!$repo);
948
949 7:3c16ed8faa07 Chris
    $repo =~ s/[^a-zA-Z0-9\._-]//g;
950 736:51c97efbe241 Chris
951 8:0c83d98252d9 Chris
    # The original Redmine.pm returns the string just calculated as
952
    # the project identifier.  That won't do for us -- we may have
953
    # (and in fact already do have, in our test instance) projects
954
    # whose repository names differ from the project identifiers.
955
956
    # This is a rather fundamental change because it means that almost
957
    # every request needs more than one database query -- which
958
    # prompts us to start passing around $dbh instead of connecting
959
    # locally within each function as is done in Redmine.pm.
960
961 7:3c16ed8faa07 Chris
    my $sth = $dbh->prepare(
962
        "SELECT projects.identifier FROM projects, repositories WHERE repositories.project_id = projects.id AND repositories.url LIKE ?;"
963
    );
964
965 8:0c83d98252d9 Chris
    my $cfg = Apache2::Module::get_config
966
	(__PACKAGE__, $r->server, $r->per_dir_config);
967
968
    my $prefix = $cfg->{SoundSoftwareRepoPrefix};
969
    if (!defined $prefix) { $prefix = '%/'; }
970 7:3c16ed8faa07 Chris
    my $identifier = '';
971
972 8:0c83d98252d9 Chris
    $sth->execute($prefix . $repo);
973 7:3c16ed8faa07 Chris
    my $ret = 0;
974
    if (my @row = $sth->fetchrow_array) {
975
	$identifier = $row[0];
976
    }
977
    $sth->finish();
978
    undef $sth;
979
980 517:bd1d512f9e1b Chris
    print STDERR "SoundSoftware.pm:$$: Repository '$repo' belongs to project '$identifier'\n";
981 7:3c16ed8faa07 Chris
982
    $identifier;
983
}
984
985 8:0c83d98252d9 Chris
sub get_realm {
986
    my $dbh = shift;
987
    my $project_id = shift;
988
    my $r = shift;
989
990
    my $sth = $dbh->prepare(
991
        "SELECT projects.name FROM projects WHERE projects.identifier = ?;"
992
    );
993
994
    my $name = $project_id;
995
996
    $sth->execute($project_id);
997
    my $ret = 0;
998
    if (my @row = $sth->fetchrow_array) {
999
	$name = $row[0];
1000
    }
1001
    $sth->finish();
1002
    undef $sth;
1003
1004
    # be timid about characters not permitted in auth realm and revert
1005
    # to project identifier if any are found
1006
    if ($name =~ m/[^\w\d\s\._-]/) {
1007
	$name = $project_id;
1008 733:c7a731db96e5 Chris
    } elsif ($name =~ m/^\s*$/) {
1009
	# empty or whitespace
1010
	$name = $project_id;
1011
    }
1012
1013
    if ($name =~ m/^\s*$/) {
1014
        # nothing even in $project_id -- probably a nonexistent project.
1015
        # use repo name instead (don't want to admit to user that project
1016
        # doesn't exist)
1017
        my $location = $r->location;
1018 737:1ce6efe3db0e Chris
        my ($repo) = $r->uri =~ m{$location/*([^/]*)};
1019 733:c7a731db96e5 Chris
        $name = $repo;
1020 8:0c83d98252d9 Chris
    }
1021
1022 1271:cf4cc816278a Chris
#    my $realm = '"Mercurial repository for ' . "'$name'" . '"';
1023
# see #577:
1024
    my $realm = '"Mercurial repository for ' . "$name" . '"';
1025 8:0c83d98252d9 Chris
1026
    $realm;
1027
}
1028
1029 7:3c16ed8faa07 Chris
sub connect_database {
1030
    my $r = shift;
1031
1032 8:0c83d98252d9 Chris
    my $cfg = Apache2::Module::get_config
1033
	(__PACKAGE__, $r->server, $r->per_dir_config);
1034
1035
    return DBI->connect($cfg->{SoundSoftwareDSN},
1036 152:a389c77da9fd Chris
	                $cfg->{SoundSoftwareDbUser},
1037
		        $cfg->{SoundSoftwareDbPass});
1038 7:3c16ed8faa07 Chris
}
1039
1040
1;
1041 217:ed8222a04634 chris
#!/usr/bin/env ruby
1042
1043
# == Synopsis
1044
#
1045 241:7658d21a1493 chris
# convert-external-repos: Update local Mercurial mirrors of external repos,
1046
# by running an external command for each project requiring an update.
1047 217:ed8222a04634 chris
#
1048
# == Usage
1049
#
1050
#    convert-external-repos [OPTIONS...] -s [DIR] -r [HOST]
1051
#
1052
# == Arguments (mandatory)
1053
#
1054 241:7658d21a1493 chris
#   -s, --scm-dir=DIR         use DIR as base directory for repositories
1055 217:ed8222a04634 chris
#   -r, --redmine-host=HOST   assume Redmine is hosted on HOST. Examples:
1056
#                             -r redmine.example.net
1057
#                             -r http://redmine.example.net
1058
#                             -r https://example.net/redmine
1059
#   -k, --key=KEY             use KEY as the Redmine API key
1060 241:7658d21a1493 chris
#   -c, --command=COMMAND     use this command to update each external
1061
#                             repository: command is called with the name
1062
#                             of the project, the path to its repo, and
1063
#                             its external repo url as its three args
1064 217:ed8222a04634 chris
#
1065
# == Options
1066
#
1067
#   --http-user=USER          User for HTTP Basic authentication with Redmine WS
1068
#   --http-pass=PASSWORD      Password for Basic authentication with Redmine WS
1069
#   -t, --test                only show what should be done
1070
#   -h, --help                show help and exit
1071
#   -v, --verbose             verbose
1072
#   -V, --version             print version and exit
1073
#   -q, --quiet               no log
1074
1075
1076
require 'getoptlong'
1077
require 'find'
1078
require 'etc'
1079
1080
Version = "1.0"
1081
1082
opts = GetoptLong.new(
1083 241:7658d21a1493 chris
                      ['--scm-dir',      '-s', GetoptLong::REQUIRED_ARGUMENT],
1084 217:ed8222a04634 chris
                      ['--redmine-host', '-r', GetoptLong::REQUIRED_ARGUMENT],
1085
                      ['--key',          '-k', GetoptLong::REQUIRED_ARGUMENT],
1086
                      ['--http-user',          GetoptLong::REQUIRED_ARGUMENT],
1087
                      ['--http-pass',          GetoptLong::REQUIRED_ARGUMENT],
1088 241:7658d21a1493 chris
                      ['--command' ,     '-c', GetoptLong::REQUIRED_ARGUMENT],
1089 217:ed8222a04634 chris
                      ['--test',         '-t', GetoptLong::NO_ARGUMENT],
1090
                      ['--verbose',      '-v', GetoptLong::NO_ARGUMENT],
1091
                      ['--version',      '-V', GetoptLong::NO_ARGUMENT],
1092
                      ['--help'   ,      '-h', GetoptLong::NO_ARGUMENT],
1093
                      ['--quiet'  ,      '-q', GetoptLong::NO_ARGUMENT]
1094
                      )
1095
1096
$verbose      = 0
1097
$quiet        = false
1098
$redmine_host = ''
1099
$repos_base   = ''
1100
$http_user    = ''
1101
$http_pass    = ''
1102
$test         = false
1103
1104 437:102056ec2de9 chris
$mirrordir    = '/var/mirror'
1105
1106 217:ed8222a04634 chris
def log(text, options={})
1107
  level = options[:level] || 0
1108
  puts text unless $quiet or level > $verbose
1109
  exit 1 if options[:exit]
1110
end
1111
1112
def system_or_raise(command)
1113
  raise "\"#{command}\" failed" unless system command
1114
end
1115
1116
begin
1117
  opts.each do |opt, arg|
1118
    case opt
1119 241:7658d21a1493 chris
    when '--scm-dir';        $repos_base   = arg.dup
1120 217:ed8222a04634 chris
    when '--redmine-host';   $redmine_host = arg.dup
1121
    when '--key';            $api_key      = arg.dup
1122
    when '--http-user';      $http_user    = arg.dup
1123
    when '--http-pass';      $http_pass    = arg.dup
1124 241:7658d21a1493 chris
    when '--command';        $command      = arg.dup
1125 217:ed8222a04634 chris
    when '--verbose';        $verbose += 1
1126
    when '--test';           $test = true
1127
    when '--version';        puts Version; exit
1128 1336:b61a51fb42b9 Chris
    when '--help';           puts "Read source for documentation"; exit
1129 217:ed8222a04634 chris
    when '--quiet';          $quiet = true
1130
    end
1131
  end
1132
rescue
1133
  exit 1
1134
end
1135
1136
if $test
1137
  log("running in test mode")
1138
end
1139
1140 241:7658d21a1493 chris
if ($redmine_host.empty? or $repos_base.empty? or $command.empty?)
1141 1336:b61a51fb42b9 Chris
  puts "Read source for documentation"; exit
1142 217:ed8222a04634 chris
end
1143
1144
unless File.directory?($repos_base)
1145
  log("directory '#{$repos_base}' doesn't exist", :exit => true)
1146
end
1147
1148
begin
1149
  require 'active_resource'
1150
rescue LoadError
1151
  log("This script requires activeresource.\nRun 'gem install activeresource' to install it.", :exit => true)
1152
end
1153
1154
class Project < ActiveResource::Base
1155
  self.headers["User-agent"] = "SoundSoftware external repository converter/#{Version}"
1156 1336:b61a51fb42b9 Chris
  self.format = :xml
1157 217:ed8222a04634 chris
end
1158
1159
log("querying Redmine for projects...", :level => 1);
1160
1161
$redmine_host.gsub!(/^/, "http://") unless $redmine_host.match("^https?://")
1162
$redmine_host.gsub!(/\/$/, '')
1163
1164
Project.site = "#{$redmine_host}/sys";
1165
Project.user = $http_user;
1166
Project.password = $http_pass;
1167
1168
begin
1169
  # Get all active projects that have the Repository module enabled
1170
  projects = Project.find(:all, :params => {:key => $api_key})
1171 1336:b61a51fb42b9 Chris
rescue ActiveResource::ForbiddenAccess
1172
  log("Request was denied by your Redmine server. Make sure that 'WS for repository management' is enabled in application settings and that you provided the correct API key.")
1173 217:ed8222a04634 chris
rescue => e
1174
  log("Unable to connect to #{Project.site}: #{e}", :exit => true)
1175
end
1176
1177
if projects.nil?
1178
  log('no project found, perhaps you forgot to "Enable WS for repository management"', :exit => true)
1179
end
1180
1181
log("retrieved #{projects.size} projects", :level => 1)
1182
1183
projects.each do |project|
1184
  log("treating project #{project.name}", :level => 1)
1185
1186
  if project.identifier.empty?
1187
    log("\tno identifier for project #{project.name}")
1188
    next
1189 1445:0c7b3bb73517 Chris
  elsif not project.identifier.match(/^[a-z0-9_\-]+$/)
1190 217:ed8222a04634 chris
    log("\tinvalid identifier for project #{project.name} : #{project.identifier}");
1191
    next
1192
  end
1193
1194
  if !project.respond_to?(:repository) or !project.repository.is_external?
1195
    log("\tproject #{project.identifier} does not use an external repository");
1196
    next
1197
  end
1198
1199
  external_url = project.repository.external_url;
1200
  log("\tproject #{project.identifier} has external repository url #{external_url}");
1201
1202
  if !external_url.match(/^[a-z][a-z+]{0,8}[a-z]:\/\//)
1203
    log("\tthis doesn't look like a plausible url to me, skipping")
1204
    next
1205
  end
1206
1207
  repos_path = File.join($repos_base, project.identifier).gsub(File::SEPARATOR, File::ALT_SEPARATOR || File::SEPARATOR)
1208
1209 241:7658d21a1493 chris
  unless File.directory?(repos_path)
1210
    log("\tproject repo directory '#{repos_path}' doesn't exist")
1211 217:ed8222a04634 chris
    next
1212
  end
1213
1214 241:7658d21a1493 chris
  system($command, project.identifier, repos_path, external_url)
1215 437:102056ec2de9 chris
1216
  $cache_clearance_file = File.join($mirrordir, project.identifier, 'url_changed')
1217
  if File.file?($cache_clearance_file)
1218
    log("\tproject repo url has changed, requesting cache clearance")
1219
    if project.post(:repository_cache, :key => $api_key)
1220
      File.delete($cache_clearance_file)
1221
    end
1222
  end
1223 217:ed8222a04634 chris
1224
end
1225
1226 1538:87bea4981d6d Chris
#!/usr/bin/env ruby
1227
1228
# Create authormap files for hg repos based on the changeset & project
1229
# member info available to Redmine.
1230
#
1231
# We have a set of hg repos in a given directory:
1232
#
1233
# /var/hg/repo_1
1234
# /var/hg/repo_2
1235
# /var/hg/repo_3
1236
#
1237
# and we want to produce authormap files in another directory:
1238
#
1239
# /var/repo-export/authormap/authormap_repo_1
1240
# /var/repo-export/authormap/authormap_repo_2
1241
# /var/repo-export/authormap/authormap_repo_3
1242
#
1243
# This script does that, if given the two directory names as arguments
1244
# to the -s and -o options. In the above example:
1245
#
1246 1543:05d639e5d59b Chris
# ./script/rails runner -e production extra/soundsoftware/create-repo-authormaps.rb -s /var/hg -o /var/repo-export/authormap
1247 1538:87bea4981d6d Chris
#
1248
# Note that this script will overwrite any existing authormap
1249
# files. (That's why the output files are given an authormap_ prefix,
1250
# so we're less likely to clobber something else if the user gets the
1251
# arguments wrong.)
1252
1253
require 'getoptlong'
1254
1255
opts = GetoptLong.new(
1256 1543:05d639e5d59b Chris
                      ['--scm-dir', '-s', GetoptLong::REQUIRED_ARGUMENT],
1257
                      ['--out-dir', '-o', GetoptLong::REQUIRED_ARGUMENT],
1258
                      ['--environment', '-e', GetoptLong::OPTIONAL_ARGUMENT]
1259 1538:87bea4981d6d Chris
)
1260
1261
$repos_base   = ''
1262
$out_base     = ''
1263
1264
def usage
1265
  puts "See source code for supported options"
1266
  exit
1267
end
1268
1269
begin
1270
  opts.each do |opt, arg|
1271
    case opt
1272
    when '--scm-dir';   $repos_base   = arg.dup
1273
    when '--out-dir';   $out_base     = arg.dup
1274
    end
1275
  end
1276
rescue
1277
  exit 1
1278
end
1279
1280
if ($repos_base.empty? or $out_base.empty?)
1281
  usage
1282
end
1283
1284
unless File.directory?($repos_base)
1285 1540:322d7b57e5f0 chris
  puts "input directory '#{$repos_base}' doesn't exist"
1286
  exit 1
1287 1538:87bea4981d6d Chris
end
1288
1289
unless File.directory?($out_base)
1290 1540:322d7b57e5f0 chris
  puts "output directory '#{$out_base}' doesn't exist"
1291
  exit 1
1292 1538:87bea4981d6d Chris
end
1293
1294
projects = Project.find(:all)
1295
1296
if projects.nil?
1297 1540:322d7b57e5f0 chris
  puts 'No projects found'
1298
  exit 1
1299 1538:87bea4981d6d Chris
end
1300
1301
projects.each do |proj|
1302 1548:fd4cc11ae096 Chris
1303
  next unless proj.is_public
1304
1305 1538:87bea4981d6d Chris
  next unless proj.respond_to?(:repository)
1306
1307
  repo = proj.repository
1308 1539:22d57b0e0a77 chris
  next if repo.nil? or repo.url.empty?
1309 1538:87bea4981d6d Chris
1310
  repo_url = repo.url
1311
  repo_url = repo_url.gsub(/^file:\/*/, "/");
1312
  if repo_url != File.join($repos_base, proj.identifier)
1313 1542:60acfbd8f6d6 Chris
    puts "Project #{proj.identifier} has repo in unsupported location #{repo_url}, skipping"
1314 1538:87bea4981d6d Chris
    next
1315
  end
1316
1317 1542:60acfbd8f6d6 Chris
  committers = repo.committers
1318 1538:87bea4981d6d Chris
1319
  authormap = ""
1320 1542:60acfbd8f6d6 Chris
  committers.each do |c, uid|
1321 1552:3a2254124fa8 Chris
1322
    # Some of our repos have broken email addresses in them: e.g. one
1323
    # changeset has a committer name of the form
1324
    #
1325
    # NAME <name <NAME <name@example.com">
1326
    #
1327
    # I don't know how it got like that... If the committer has more
1328
    # than one '<' in it, truncate it just before the first one, and
1329 1553:baac54711ee9 Chris
    # then look up the author name again.
1330
    #
1331 1552:3a2254124fa8 Chris
    if c =~ /<.*</ then
1332 1553:baac54711ee9 Chris
      # So this is a completely pathological case
1333
      user = User.find_by_id uid
1334
      if user.nil? then
1335
        # because the given committer is bogus, we must write something in the map
1336 1554:e5c9809534a2 Chris
        name = c.sub(/\s*<.*$/, "")
1337
        authormap << "#{c}=#{name} <unknown@example.com>\n"
1338 1553:baac54711ee9 Chris
      else
1339
        authormap << "#{c}=#{user.name} <#{user.mail}>\n"
1340
      end
1341
    elsif not c =~ /[^<]+<.*@.*>/ then
1342
      # This is the "normal" case that needs work, where a user has
1343
      # their name in the commit but no email address
1344 1542:60acfbd8f6d6 Chris
      user = User.find_by_id uid
1345 1539:22d57b0e0a77 chris
      authormap << "#{c}=#{user.name} <#{user.mail}>\n" unless user.nil?
1346 1538:87bea4981d6d Chris
    end
1347
  end
1348
1349 1539:22d57b0e0a77 chris
  File.open(File.join($out_base, "authormap_#{proj.identifier}"), "w") do |f|
1350 1538:87bea4981d6d Chris
    f.puts(authormap)
1351
  end
1352
1353
end
1354
1355 226:5b028aef59a7 chris
#!/usr/bin/perl -w
1356
1357
# Read a Doxyfile and print it out again to stdout, with only
1358
# whitelisted keys in it and with some keys set to pre-fixed values.
1359
#
1360
# Note that OUTPUT_DIRECTORY is not included; it should be added by
1361
# the caller
1362
1363
use strict;
1364
1365
my $txt = join "", <>;
1366
$txt =~ s/^\s*#.*$//gm;
1367
$txt =~ s/\\\n//gs;
1368
$txt =~ s/\r//g;
1369
$txt =~ s/\n\s*\n/\n/gs;
1370
1371
my %fixed = (
1372
    FULL_PATH_NAMES => "NO",
1373
    SYMBOL_CACHE_SIZE => 2,
1374
    EXCLUDE_SYMLINKS => "YES",
1375
    GENERATE_HTML => "YES",
1376
    PERL_PATH => "/usr/bin/perl",
1377
    HAVE_DOT => "YES",
1378
    HTML_OUTPUT => ".",
1379 228:3c084a25d8ab chris
    HTML_DYNAMIC_SECTIONS => "NO",
1380 226:5b028aef59a7 chris
    SEARCHENGINE => "NO",
1381
    DOT_FONTNAME => "FreeMono",
1382
    DOT_FONTSIZE => 10,
1383
    DOT_FONTPATH => "/usr/share/fonts/truetype/freefont",
1384
    DOT_IMAGE_FORMAT => "png",
1385
    DOT_PATH => "/usr/bin/dot",
1386
    DOT_TRANSPARENT => "YES",
1387
);
1388
1389 233:df89e7aa3ce8 Chris
# These are the keys that are safe to take from the output and include
1390
# in the output; they may still need to be checked for safe values (if
1391
# file paths).
1392 226:5b028aef59a7 chris
my @safe = qw(
1393 233:df89e7aa3ce8 Chris
INPUT
1394
FILE_PATTERNS
1395
EXAMPLE_PATH
1396
EXAMPLE_PATTERNS
1397
IMAGE_PATH
1398
INCLUDE_PATH
1399
INCLUDE_FILE_PATTERNS
1400 226:5b028aef59a7 chris
DOXYFILE_ENCODING
1401
PROJECT_NAME
1402
PROJECT_NUMBER
1403
CREATE_SUBDIRS
1404
OUTPUT_LANGUAGE
1405
BRIEF_MEMBER_DESC
1406
REPEAT_BRIEF
1407
ABBREVIATE_BRIEF
1408
ALWAYS_DETAILED_SEC
1409
INLINE_INHERITED_MEMB
1410
STRIP_FROM_PATH
1411
STRIP_FROM_INC_PATH
1412
JAVADOC_AUTOBRIEF
1413
QT_AUTOBRIEF
1414
MULTILINE_CPP_IS_BRIEF
1415
INHERIT_DOCS
1416
SEPARATE_MEMBER_PAGES
1417
TAB_SIZE
1418
ALIASES
1419
OPTIMIZE_OUTPUT_FOR_C
1420
OPTIMIZE_OUTPUT_JAVA
1421
OPTIMIZE_FOR_FORTRAN
1422
OPTIMIZE_OUTPUT_VHDL
1423
EXTENSION_MAPPING
1424
BUILTIN_STL_SUPPORT
1425
CPP_CLI_SUPPORT
1426
SIP_SUPPORT
1427
IDL_PROPERTY_SUPPORT
1428
DISTRIBUTE_GROUP_DOC
1429
SUBGROUPING
1430
TYPEDEF_HIDES_STRUCT
1431
EXTRACT_ALL
1432
EXTRACT_PRIVATE
1433
EXTRACT_STATIC
1434
EXTRACT_LOCAL_CLASSES
1435
EXTRACT_LOCAL_METHODS
1436
EXTRACT_ANON_NSPACES
1437
HIDE_UNDOC_MEMBERS
1438
HIDE_UNDOC_CLASSES
1439
HIDE_FRIEND_COMPOUNDS
1440
HIDE_IN_BODY_DOCS
1441
INTERNAL_DOCS
1442
HIDE_SCOPE_NAMES
1443
SHOW_INCLUDE_FILES
1444
FORCE_LOCAL_INCLUDES
1445
INLINE_INFO
1446
SORT_MEMBER_DOCS
1447
SORT_BRIEF_DOCS
1448
SORT_MEMBERS_CTORS_1ST
1449
SORT_GROUP_NAMES
1450
SORT_BY_SCOPE_NAME
1451
GENERATE_TODOLIST
1452
GENERATE_TESTLIST
1453
GENERATE_BUGLIST
1454
GENERATE_DEPRECATEDLIST
1455
ENABLED_SECTIONS
1456
MAX_INITIALIZER_LINES
1457
SHOW_USED_FILES
1458
SHOW_DIRECTORIES
1459
SHOW_FILES
1460
SHOW_NAMESPACES
1461
QUIET
1462
WARNINGS
1463
WARN_IF_UNDOCUMENTED
1464
WARN_IF_DOC_ERROR
1465
WARN_NO_PARAMDOC
1466
INPUT_ENCODING
1467
RECURSIVE
1468
EXCLUDE
1469
EXCLUDE_SYMLINKS
1470
EXCLUDE_PATTERNS
1471
EXCLUDE_SYMBOLS
1472
EXAMPLE_RECURSIVE
1473
SOURCE_BROWSER
1474
INLINE_SOURCES
1475
STRIP_CODE_COMMENTS
1476
REFERENCED_BY_RELATION
1477
REFERENCES_RELATION
1478
REFERENCES_LINK_SOURCE
1479
VERBATIM_HEADERS
1480
ALPHABETICAL_INDEX
1481
COLS_IN_ALPHA_INDEX
1482
IGNORE_PREFIX
1483
HTML_TIMESTAMP
1484
HTML_ALIGN_MEMBERS
1485
ENABLE_PREPROCESSING
1486
MACRO_EXPANSION
1487
EXPAND_ONLY_PREDEF
1488
SEARCH_INCLUDES
1489
PREDEFINED
1490
EXPAND_AS_DEFINED
1491
SKIP_FUNCTION_MACROS
1492
ALLEXTERNALS
1493
EXTERNAL_GROUPS
1494
CLASS_DIAGRAMS
1495
HIDE_UNDOC_RELATIONS
1496
CLASS_GRAPH
1497
COLLABORATION_GRAPH
1498
GROUP_GRAPHS
1499
UML_LOOK
1500
TEMPLATE_RELATIONS
1501
INCLUDE_GRAPH
1502
INCLUDED_BY_GRAPH
1503
CALL_GRAPH
1504
CALLER_GRAPH
1505
GRAPHICAL_HIERARCHY
1506
DIRECTORY_GRAPH
1507
DOT_GRAPH_MAX_NODES
1508
MAX_DOT_GRAPH_DEPTH
1509
DOT_MULTI_TARGETS
1510
DOT_CLEANUP
1511
);
1512
1513
my %safehash;
1514
for my $sk (@safe) { $safehash{$sk} = 1; }
1515
1516
my @lines = split "\n", $txt;
1517
1518
my %settings;
1519
1520
sub is_safe {
1521
    my $key = shift;
1522
    defined $safehash{$key} and $safehash{$key} == 1;
1523
}
1524
1525
sub has_file_path {
1526
    # Returns true if the given key expects a file path as a value.
1527
    # We only need to test keys that are safe; unsafe keys have been
1528
    # rejected already.
1529
    my $key = shift;
1530
    $key eq "INPUT" or
1531
	$key =~ /^OUTPUT_/ or
1532
	$key =~ /_PATH$/ or
1533
	$key =~ /_PATTERNS$/;
1534
}
1535
1536
sub is_safe_file_path {
1537
    my $value = shift;
1538
    not $value =~ /^\// and not $value =~ /\.\./;
1539
}
1540
1541
foreach my $line (@lines) {
1542
1543
    chomp $line;
1544
    my ($key, $value) = split /\s*=\s*/, $line;
1545
1546
    next if !defined $key;
1547
1548
    if ($key =~ /^GENERATE_/ and not $key =~ /LIST$/) {
1549
	print STDERR "NOTE: Setting $key explicitly to NO\n";
1550
	$settings{$key} = "NO";
1551
	next;
1552
    }
1553
1554
    if (!is_safe($key)) {
1555
	print STDERR "NOTE: Skipping non-whitelisted key $key\n";
1556
	next;
1557
    }
1558
1559
    if (has_file_path($key) and !is_safe_file_path($value)) {
1560
	print STDERR "ERROR: Unsafe file path \"$value\" for key $key\n";
1561
	exit 1;
1562
    }
1563
1564
    $settings{$key} = $value;
1565
}
1566
1567 228:3c084a25d8ab chris
foreach my $key (keys %fixed) {
1568
    my $value = $fixed{$key};
1569
    print STDERR "NOTE: Setting $key to fixed value $value\n";
1570
    $settings{$key} = $value;
1571
}
1572
1573 226:5b028aef59a7 chris
print join "\n", map { "$_ = $settings{$_}" } keys %settings;
1574
print "\n";
1575 1543:05d639e5d59b Chris
#!/bin/bash
1576
1577
set -e
1578
1579
progdir=$(dirname $0)
1580
case "$progdir" in
1581
    /*) ;;
1582
    *) progdir="$(pwd)/$progdir" ;;
1583
esac
1584
1585
rails_scriptdir="$progdir/../../script"
1586
rails="$rails_scriptdir/rails"
1587
1588
if [ ! -x "$rails" ]; then
1589
    echo "Expected to find rails executable at $rails"
1590
    exit 2
1591
fi
1592
1593
fastexport="$progdir/../fast-export/hg-fast-export.sh"
1594
if [ ! -x "$fastexport" ]; then
1595
    echo "Expected to find hg-fast-export.sh executable at $fastexport"
1596
    exit 2
1597
fi
1598
1599 1546:248c402992ba Chris
environment="$1"
1600
hgdir="$2"
1601
gitdir="$3"
1602 1543:05d639e5d59b Chris
1603
if [ -z "$hgdir" ] || [ -z "$gitdir" ]; then
1604 1546:248c402992ba Chris
    echo "Usage: $0 <environment> <hgdir> <gitdir>"
1605
    echo "  where"
1606
    echo "  - environment is the Rails environment (development or production)"
1607
    echo "  - hgdir is the directory containing project Mercurial repositories"
1608
    echo "  - gitdir is the directory in which output git repositories are to be"
1609
    echo "    created or updated"
1610 1543:05d639e5d59b Chris
    exit 2
1611
fi
1612
1613
if [ ! -d "$hgdir" ]; then
1614
    echo "Mercurial repository directory $hgdir not found"
1615
    exit 1
1616
fi
1617
1618
if [ ! -d "$gitdir" ]; then
1619
    echo "Target git repository dir $gitdir not found (please create at least the empty directory)"
1620
    exit 1
1621
fi
1622
1623
set -u
1624
1625 1550:7d825cbd76c8 Chris
authordir="$gitdir/__AUTHORMAPS"
1626 1543:05d639e5d59b Chris
mkdir -p "$authordir"
1627
1628 1550:7d825cbd76c8 Chris
wastedir="$gitdir/__WASTE"
1629
mkdir -p "$wastedir"
1630
1631 1557:9d6d2f696782 Chris
echo
1632
echo "$0 starting at $(date)"
1633
1634 1547:bca3b5e5bbf2 Chris
echo "Extracting author maps..."
1635 1546:248c402992ba Chris
1636 1550:7d825cbd76c8 Chris
# Delete any existing authormap files, because we want to ensure we
1637
# don't have an authormap for any project that was exportable but has
1638
# become non-exportable (e.g. has gone private)
1639 1551:36dddb6755f6 Chris
rm -f "$authordir/*"
1640 1550:7d825cbd76c8 Chris
1641 1546:248c402992ba Chris
"$rails" runner -e "$environment" "$progdir/create-repo-authormaps.rb" \
1642 1543:05d639e5d59b Chris
	 -s "$hgdir" -o "$authordir"
1643
1644
for hgrepo in "$hgdir"/*; do
1645
1646
    if [ ! -d "$hgrepo/.hg" ]; then
1647
	echo "Directory $hgrepo does not appear to be a Mercurial repo, skipping"
1648
	continue
1649
    fi
1650
1651
    reponame=$(basename "$hgrepo")
1652
    authormap="$authordir/authormap_$reponame"
1653 1559:21098b932cb8 Chris
1654
    git_repodir="$gitdir/$reponame"
1655 1543:05d639e5d59b Chris
1656
    if [ ! -f "$authormap" ]; then
1657 1547:bca3b5e5bbf2 Chris
	echo "No authormap file was created for repo $reponame, skipping"
1658 1550:7d825cbd76c8 Chris
1659
	# If there is no authormap file, then we should not have a git
1660
	# mirror -- this is a form of access control, not just an
1661
	# optimisation (authormap files are expected to exist for all
1662
	# exportable projects, even if empty). So if a git mirror
1663
	# exists, we move it away
1664 1560:2c67e414ab46 Chris
	if [ -d "$git_repodir" ]; then
1665
	    mv "$git_repodir" "$wastedir/$(date +%s).$reponame"
1666 1550:7d825cbd76c8 Chris
	fi
1667
1668 1543:05d639e5d59b Chris
	continue
1669
    fi
1670
1671 1559:21098b932cb8 Chris
    if [ ! -d "$git_repodir" ]; then
1672 1561:6074fffd8a1d Chris
	git init --bare "$git_repodir"
1673 1543:05d639e5d59b Chris
    fi
1674
1675 1547:bca3b5e5bbf2 Chris
    echo
1676 1546:248c402992ba Chris
    echo "About to run fast export for repo $reponame..."
1677 1543:05d639e5d59b Chris
1678
    (
1679 1561:6074fffd8a1d Chris
	cd "$git_repodir"
1680 1549:28cde511f312 Chris
1681
        # Force is necessary because git-fast-import (or git) can't handle
1682
        # branches having more than one head ("Error: repository has at
1683
        # least one unnamed head"), which happens from time to time in
1684
        # valid Hg repos. With --force apparently it will just pick one
1685
        # of the two heads arbitrarily, which is also alarming but is
1686
        # more likely to be useful
1687 1558:a0c46d6fe7bc Chris
	"$fastexport" --quiet -r "$hgrepo" --hgtags -A "$authormap" --force
1688 1555:1786830cc35d Chris
1689
        git update-server-info
1690 1543:05d639e5d59b Chris
    )
1691
1692
    echo "Fast export done"
1693
1694
done
1695
1696 1557:9d6d2f696782 Chris
echo "$0 finishing at $(date)"
1697 1543:05d639e5d59b Chris
1698 203:1e55195bca45 chris
#!/bin/bash
1699
1700
# Run this script from anywhere
1701
1702
# Enumerate Hg repos; make sure they're up to date; extract docs for
1703
# each
1704
1705
hgdir="/var/hg"
1706
docdir="/var/doc"
1707 223:c3544e9fd588 chris
logfile="/var/www/test-cannam/log/extract-docs.log"
1708
1709
redgrp="redmine"
1710 203:1e55195bca45 chris
1711 218:292cde42265a chris
apikey=""
1712 339:5410d82c12df chris
apischeme="https"
1713 218:292cde42265a chris
apihost=""
1714
apiuser=""
1715
apipass=""
1716
1717 203:1e55195bca45 chris
progdir=$(dirname $0)
1718
case "$progdir" in
1719
    /*) ;;
1720
    *) progdir="$(pwd)/$progdir" ;;
1721
esac
1722
1723 411:e7ba81c8dc5a chris
types="doxygen javadoc matlabdocs" # Do Doxygen first (it can be used for Java too)
1724 203:1e55195bca45 chris
1725
for x in $types; do
1726
    if [ ! -x "$progdir/extract-$x.sh" ]; then
1727
	echo "Helper script not available: $progdir/extract-$x.sh"
1728
	exit 1
1729
    fi
1730
done
1731
1732 218:292cde42265a chris
enable_embedded()
1733
{
1734
    p="$1"
1735 228:3c084a25d8ab chris
    if [ -n "$apikey" ]; then
1736
	if [ -n "$apiuser" ]; then
1737 339:5410d82c12df chris
	    sudo -u docgen curl -u "$apiuser":"$apipass" "$apischeme://$apihost/sys/projects/$p/embedded.xml?enable=1&key=$apikey" -d ""
1738 228:3c084a25d8ab chris
	else
1739 339:5410d82c12df chris
	    sudo -u docgen curl "$apischeme://$apihost/sys/projects/$p/embedded.xml?enable=1&key=$apikey" -d ""
1740 228:3c084a25d8ab chris
	fi
1741
    else
1742
	echo "Can't enable Embedded, API not configured" 1>&2
1743 218:292cde42265a chris
    fi
1744
}
1745
1746 223:c3544e9fd588 chris
# We want to ensure the doc extraction is done by the unprivileged
1747
# user docgen, which is not a member of any interesting group
1748
#
1749
# To this end, we create the tmpdir with user docgen and group
1750
# www-data, and use the www-data user to pull out an archive of the Hg
1751
# repo tip into a location beneath that, before using the docgen user
1752
# to extract docs from that location and write them into the tmpdir
1753
1754
# Same tmpdir for each project: we delete and recreate to avoid
1755
# cleanup duty from lots of directories being created
1756
#
1757
tmpdir=$(mktemp -d "$docdir/tmp_XXXXXX")
1758
1759
fail()
1760
{
1761
    message="$1"
1762
    echo "$message" 1>&2
1763
    case "$tmpdir" in
1764
	*/tmp*) rm -rf "$tmpdir";;
1765
	*);;
1766
    esac
1767
    exit 1
1768
}
1769
1770
case "$tmpdir" in
1771
    /*) ;;
1772
    *) fail "Temporary directory creation failed";;
1773
esac
1774
1775
chown docgen.www-data "$tmpdir" || fail "Temporary directory ownership change failed"
1776
chmod g+rwx "$tmpdir" || fail "Temporary directory permissions change failed"
1777
1778 203:1e55195bca45 chris
for projectdir in "$hgdir"/* ; do
1779
1780
    if [ -d "$projectdir" ] && [ -d "$projectdir/.hg" ]; then
1781
1782 223:c3544e9fd588 chris
	if ! sudo -u www-data hg -R "$projectdir" -q update; then
1783
	    echo "Failed to update Hg in $projectdir, skipping" 1>&2
1784
	    continue
1785
	fi
1786
1787 203:1e55195bca45 chris
	project=$(basename "$projectdir")
1788
1789 223:c3544e9fd588 chris
	tmptargetdir="$tmpdir/doc"
1790
	snapshotdir="$tmpdir/hgsnapshot"
1791 203:1e55195bca45 chris
1792 223:c3544e9fd588 chris
	rm -rf "$tmptargetdir" "$snapshotdir"
1793
1794 226:5b028aef59a7 chris
	mkdir -m 770 "$tmptargetdir" || fail "Temporary target directory creation failed"
1795
	chown docgen.www-data "$tmptargetdir" || fail "Temporary target directory ownership change failed"
1796 223:c3544e9fd588 chris
1797
	mkdir -m 770 "$snapshotdir" || fail "Snapshot directory creation failed"
1798
	chown docgen.www-data "$snapshotdir" || fail "Snapshot directory ownership change failed"
1799
1800
	hgparents=$(sudo -u www-data hg -R "$projectdir" parents)
1801
	if [ -z "$hgparents" ]; then
1802
	    echo "Hg repo at $projectdir has no working copy (empty repo?), skipping"
1803
	    continue
1804
	else
1805
	    echo "Found non-empty Hg repo: $projectdir for project $project"
1806
	fi
1807
1808
	if ! sudo -u www-data hg -R "$projectdir" archive -r tip -t files "$snapshotdir"; then
1809
	    echo "Failed to pick archive from $projectdir, skipping" 1>&2
1810
	    continue
1811
	fi
1812 203:1e55195bca45 chris
1813
	targetdir="$docdir/$project"
1814
1815 223:c3544e9fd588 chris
	echo "Temporary dir is $tmpdir, temporary doc dir is $tmptargetdir, snapshot dir is $snapshotdir, eventual target is $targetdir"
1816 203:1e55195bca45 chris
1817
	for x in $types; do
1818 226:5b028aef59a7 chris
	    if sudo -u docgen "$progdir/extract-$x.sh" "$project" "$snapshotdir" "$tmptargetdir" >> "$logfile" 2>&1; then
1819
		break
1820
	    else
1821 203:1e55195bca45 chris
		echo "Failed to extract via type $x"
1822
	    fi
1823
	done
1824
1825 223:c3544e9fd588 chris
        if [ -f "$tmptargetdir/index.html" ]; then
1826 203:1e55195bca45 chris
	    echo "Processing resulted in an index.html being created, looks good!"
1827
	    if [ ! -d "$targetdir" ] || [ ! -f "$targetdir/index.html" ]; then
1828 223:c3544e9fd588 chris
		echo "This project hasn't had doc extracted before: enabling Embedded"
1829 218:292cde42265a chris
		enable_embedded "$project"
1830 203:1e55195bca45 chris
	    fi
1831
1832
	    if [ -d "$targetdir" ]; then
1833
		mv "$targetdir" "$targetdir"_"$$" && \
1834 223:c3544e9fd588 chris
		    mv "$tmptargetdir" "$targetdir" && \
1835 203:1e55195bca45 chris
		    rm -rf "$targetdir"_"$$"
1836 223:c3544e9fd588 chris
		chgrp -R "$redgrp" "$targetdir"
1837 203:1e55195bca45 chris
	    else
1838 223:c3544e9fd588 chris
		mv "$tmptargetdir" "$targetdir"
1839
		chgrp -R "$redgrp" "$targetdir"
1840 203:1e55195bca45 chris
	    fi
1841 228:3c084a25d8ab chris
	else
1842
	    echo "Processing did not result in an index.html being created"
1843 203:1e55195bca45 chris
	fi
1844
    fi
1845
done
1846
1847 223:c3544e9fd588 chris
rm -rf "$tmpdir"
1848 203:1e55195bca45 chris
#!/bin/bash
1849
1850
docdir="/var/doc"
1851
1852 228:3c084a25d8ab chris
progdir=$(dirname $0)
1853
case "$progdir" in
1854
    /*) ;;
1855
    *) progdir="$(pwd)/$progdir" ;;
1856
esac
1857
1858 203:1e55195bca45 chris
project="$1"
1859 223:c3544e9fd588 chris
projectdir="$2"
1860
targetdir="$3"
1861 203:1e55195bca45 chris
1862 223:c3544e9fd588 chris
if [ -z "$project" ] || [ -z "$targetdir" ] || [ -z "$projectdir" ]; then
1863
    echo "Usage: $0 <project> <projectdir> <targetdir>"
1864 203:1e55195bca45 chris
    exit 2
1865
fi
1866
1867 223:c3544e9fd588 chris
if [ ! -d "$projectdir" ]; then
1868
    echo "Project directory $projectdir not found"
1869 203:1e55195bca45 chris
    exit 1
1870
fi
1871
1872
if [ ! -d "$targetdir" ]; then
1873
    echo "Target dir $targetdir not found"
1874
    exit 1
1875
fi
1876
1877
if [ -f "$targetdir/index.html" ]; then
1878
    echo "Target dir $targetdir already contains index.html"
1879
    exit 1
1880
fi
1881
1882
doxyfile=$(find "$projectdir" -type f -name Doxyfile -print | head -1)
1883
1884
if [ -z "$doxyfile" ]; then
1885
    echo "No Doxyfile found for project $project"
1886
    exit 1
1887
fi
1888
1889
echo "Project $project contains a Doxyfile at $doxyfile"
1890
1891
cd "$projectdir" || exit 1
1892
1893 228:3c084a25d8ab chris
"$progdir/doxysafe.pl" "$doxyfile" | \
1894
    sed -e '$a OUTPUT_DIRECTORY='"$targetdir" | \
1895 203:1e55195bca45 chris
    doxygen -
1896
1897
#!/bin/bash
1898 168:c1e9f2dab1d5 chris
1899 203:1e55195bca45 chris
docdir="/var/doc"
1900 168:c1e9f2dab1d5 chris
1901 203:1e55195bca45 chris
project="$1"
1902 223:c3544e9fd588 chris
projectdir="$2"
1903
targetdir="$3"
1904 168:c1e9f2dab1d5 chris
1905 223:c3544e9fd588 chris
if [ -z "$project" ] || [ -z "$targetdir" ] || [ -z "$projectdir" ]; then
1906
    echo "Usage: $0 <project> <projectdir> <targetdir>"
1907 203:1e55195bca45 chris
    exit 2
1908 168:c1e9f2dab1d5 chris
fi
1909
1910 223:c3544e9fd588 chris
if [ ! -d "$projectdir" ]; then
1911
    echo "Project directory $projectdir not found"
1912 203:1e55195bca45 chris
    exit 1
1913
fi
1914 168:c1e9f2dab1d5 chris
1915 203:1e55195bca45 chris
if [ ! -d "$targetdir" ]; then
1916
    echo "Target dir $targetdir not found"
1917
    exit 1
1918
fi
1919 168:c1e9f2dab1d5 chris
1920 203:1e55195bca45 chris
if [ -f "$targetdir/index.html" ]; then
1921
    echo "Target dir $targetdir already contains index.html"
1922
    exit 1
1923 178:2cec5c53cd68 chris
fi
1924 168:c1e9f2dab1d5 chris
1925 191:0d1c6fa50d3a chris
# Identify Java files whose packages match the trailing parts of their
1926
# paths, and list the resulting packages and the path prefixes with
1927
# the packages removed (so as to find code in subdirs,
1928
# e.g. src/com/example/...)
1929
1930
# Regexp match is very rough; check what is actually permitted for
1931
# package declarations
1932
1933 203:1e55195bca45 chris
find "$projectdir" -type f -name \*.java \
1934 989:3549525ba22a Chris
    -exec egrep '^ *package +[a-zA-Z][a-zA-Z0-9\._-]*;.*$' \{\} /dev/null \; |
1935
    sed -e 's/\/[^\/]*: *package */:/' -e 's/;.*$//' |
1936 191:0d1c6fa50d3a chris
    sort | uniq | (
1937
	current_prefix=
1938
	current_packages=
1939
	while IFS=: read filepath package; do
1940
	    echo "Looking at $package in $filepath"
1941
	    packagepath=${package//./\/}
1942
	    prefix=${filepath%$packagepath}
1943 203:1e55195bca45 chris
	    prefix=${prefix:=$projectdir}
1944 191:0d1c6fa50d3a chris
	    if [ "$prefix" = "$filepath" ]; then
1945
		echo "Package $package does not match suffix of path $filepath, skipping"
1946
		continue
1947
	    fi
1948
	    if [ "$prefix" != "$current_prefix" ]; then
1949 450:73401a15037b Chris
		echo "Package $package matches file path and has new prefix $prefix"
1950 191:0d1c6fa50d3a chris
		if [ -n "$current_packages" ]; then
1951
		    echo "Running Javadoc for packages $current_packages from prefix $current_prefix"
1952 450:73401a15037b Chris
		    echo "Command is: javadoc -sourcepath "$current_prefix" -d "$targetdir" -subpackages $current_packages"
1953 203:1e55195bca45 chris
		    javadoc -sourcepath "$current_prefix" -d "$targetdir" -subpackages $current_packages
1954 191:0d1c6fa50d3a chris
		fi
1955
		current_prefix="$prefix"
1956 450:73401a15037b Chris
		current_packages="$package"
1957 191:0d1c6fa50d3a chris
	    else
1958 450:73401a15037b Chris
		echo "Package $package matches file path with same prefix as previous file"
1959 191:0d1c6fa50d3a chris
		current_packages="$current_packages $package"
1960
	    fi
1961
	done
1962 203:1e55195bca45 chris
	prefix=${prefix:=$projectdir}
1963 191:0d1c6fa50d3a chris
	if [ -n "$current_packages" ]; then
1964
	    echo "Running Javadoc for packages $current_packages in prefix $current_prefix"
1965 450:73401a15037b Chris
  	    echo "Command is: javadoc -sourcepath "$current_prefix" -d "$targetdir" -subpackages $current_packages"
1966 203:1e55195bca45 chris
	    javadoc -sourcepath "$current_prefix" -d "$targetdir" -subpackages $current_packages
1967 191:0d1c6fa50d3a chris
	fi
1968
    )
1969
1970 450:73401a15037b Chris
if [ -f "$targetdir"/overview-tree.html ]; then
1971
    cp "$targetdir"/overview-tree.html "$targetdir"/index.html
1972
fi
1973
1974 203:1e55195bca45 chris
# for exit code:
1975
[ -f "$targetdir/index.html" ]
1976 168:c1e9f2dab1d5 chris
1977 411:e7ba81c8dc5a chris
#!/bin/bash
1978
1979
docdir="/var/doc"
1980
1981
progdir=$(dirname $0)
1982
case "$progdir" in
1983
    /*) ;;
1984
    *) progdir="$(pwd)/$progdir" ;;
1985
esac
1986
1987
project="$1"
1988
projectdir="$2"
1989
targetdir="$3"
1990
1991
if [ -z "$project" ] || [ -z "$targetdir" ] || [ -z "$projectdir" ]; then
1992
    echo "Usage: $0 <project> <projectdir> <targetdir>"
1993
    exit 2
1994
fi
1995
1996
if [ ! -d "$projectdir" ]; then
1997
    echo "Project directory $projectdir not found"
1998
    exit 1
1999
fi
2000
2001
if [ ! -d "$targetdir" ]; then
2002
    echo "Target dir $targetdir not found"
2003
    exit 1
2004
fi
2005
2006
if [ -f "$targetdir/index.html" ]; then
2007
    echo "Target dir $targetdir already contains index.html"
2008
    exit 1
2009
fi
2010
2011
mfile=$(find "$projectdir" -type f -name \*.m -print0 | xargs -0 grep -l '^% ' | head -1)
2012
2013
if [ -z "$mfile" ]; then
2014
    echo "No MATLAB files with comments found for project $project"
2015
    exit 1
2016
fi
2017
2018
echo "Project $project contains at least one MATLAB file with comments"
2019
2020
cd "$projectdir" || exit 1
2021
2022
perl "$progdir/matlab-docs.pl" -c "$progdir/matlab-docs.conf" -d "$targetdir"
2023
2024 1563:171c31a5cca4 Chris
#!/bin/bash
2025
#
2026
# Convert an Hg repo with subrepos into a new repo in which the
2027
# subrepo contents are included in the main repo. The history of the
2028
# original and its subrepos is retained.
2029
#
2030
# Note that this script invokes itself, in order to handle nested
2031
# subrepos.
2032
#
2033
# While this does work, I'm not convinced it's entirely a good
2034
# idea. The history ends up a bit of a mess, and if it's a preliminary
2035
# to converting to git (which is one obvious reason to do this), the
2036
# history ends up even messier after that conversion.
2037
2038
set -ex
2039
2040
repo="$1"
2041
target="$2"
2042
target_subdir="$3"
2043
revision="$4"
2044
2045
if [ -z "$repo" ] || [ -z "$target" ]; then
2046
    echo "usage: $0 <repo-url> <target-dir> [<target-subdir> <revision>]"
2047
    exit 2
2048
fi
2049
2050
set -u
2051
2052
myname="$0"
2053
mydir=$(dirname "$myname")
2054
2055
reponame=$(basename "$repo")
2056
tmpdir="/tmp/flatten_$$"
2057
mkdir -p "$tmpdir"
2058
trap "rm -rf ${tmpdir}" 0
2059
2060
filemap="$tmpdir/filemap"
2061
tmprepo="$tmpdir/tmprepo"
2062
subtmp="$tmpdir/subtmp"
2063
2064
if [ -n "$revision" ]; then
2065
    hg clone -r "$revision" "$repo" "$tmprepo"
2066
else
2067
    hg clone "$repo" "$tmprepo"
2068
fi
2069
2070
read_sub() {
2071
    if [ -f "$tmprepo/.hgsub" ]; then
2072
	cat "$tmprepo/.hgsub" | sed 's/ *= */,/'
2073
    fi
2074
}
2075
2076
(   echo "exclude .hgsub"
2077
    echo "exclude .hgsubstate"
2078
    read_sub | while IFS=, read dir uri; do
2079
	echo "exclude $dir"
2080
    done
2081
    if [ -n "$target_subdir" ]; then
2082
	echo "rename . $target_subdir"
2083
    fi
2084
) > "$filemap"
2085
2086
hg convert --filemap "$filemap" "$tmprepo" "$target"
2087
(   cd "$target"
2088
    hg update
2089
)
2090
2091
read_sub | while IFS=, read dir uri; do
2092
    rm -rf "$subtmp"
2093
    revision=$(grep ' '"$dir"'$' "$tmprepo/.hgsubstate" | awk '{ print $1; }')
2094
    if [ -n "$target_subdir" ]; then
2095
	"$myname" "$tmprepo/$dir" "$subtmp" "$target_subdir/$dir" "$revision"
2096
    else
2097
	"$myname" "$tmprepo/$dir" "$subtmp" "$dir" "$revision"
2098
    fi
2099
    (   cd "$target"
2100
	hg pull -f "$subtmp" &&
2101
	    hg merge --tool internal:local &&
2102
	    hg commit -m "Merge former subrepo $dir"
2103
    )
2104
done
2105
2106 978:bbb88c44f805 Chris
2107 980:9b4919de5317 Chris
# Read an Apache log file in SoundSoftware site format from stdin and
2108
# produce some per-project stats.
2109 978:bbb88c44f805 Chris
#
2110
# Invoke with e.g.
2111
#
2112
# cat /var/log/apache2/code-access.log | \
2113
#   script/runner -e production extra/soundsoftware/get-apache-log-stats.rb
2114
2115 975:198f764e734c Chris
2116
# Use the ApacheLogRegex parser, a neat thing
2117
# See http://www.simonecarletti.com/blog/2009/02/apache-log-regex-a-lightweight-ruby-apache-log-parser/
2118
require 'apachelogregex'
2119
2120
# This is the format defined in our httpd.conf
2121
vhost_combined_format = '%v:%p %h %{X-Forwarded-For}i %l %u %t \"%r\" %>s %O \"%{Referer}i\" \"%{User-Agent}i\"'
2122
2123
parser = ApacheLogRegex.new(vhost_combined_format)
2124
2125
# project name -> count of hg clones
2126
clones = Hash.new(0)
2127
2128
# project name -> count of hg pulls
2129
pulls = Hash.new(0)
2130
2131 978:bbb88c44f805 Chris
# project name -> count of hg pushes
2132
pushes = Hash.new(0)
2133 975:198f764e734c Chris
2134
# project name -> count of hg archive requests (i.e. Download as Zip)
2135
zips = Hash.new(0)
2136
2137
# project name -> count of hits to pages under /projects/projectname
2138
hits = Hash.new(0)
2139
2140 978:bbb88c44f805 Chris
# project name -> Project object
2141
@projects = Hash.new
2142
2143 975:198f764e734c Chris
parseable = 0
2144
unparseable = 0
2145
2146 979:56a38a9f6204 Chris
def is_public_project?(project)
2147 978:bbb88c44f805 Chris
  if !project
2148
    false
2149 983:a97e573d7f87 Chris
  elsif project =~ /^\d+$/
2150
    # ignore numerical project ids, they are only used when editing projects
2151
    false
2152 978:bbb88c44f805 Chris
  elsif @projects.key?(project)
2153 979:56a38a9f6204 Chris
    @projects[project].is_public?
2154 978:bbb88c44f805 Chris
  else
2155
    pobj = Project.find_by_identifier(project)
2156
    if pobj
2157
      @projects[project] = pobj
2158 979:56a38a9f6204 Chris
      pobj.is_public?
2159 978:bbb88c44f805 Chris
    else
2160 979:56a38a9f6204 Chris
      print "Project not found: ", project, "\n"
2161 978:bbb88c44f805 Chris
      false
2162
    end
2163
  end
2164
end
2165
2166 980:9b4919de5317 Chris
def print_stats(h)
2167
  h.keys.sort { |a,b| h[b] <=> h[a] }.each do |p|
2168 982:6edb748be064 Chris
    if h[p] > 0
2169 983:a97e573d7f87 Chris
      print h[p], " ", @projects[p].name, " [", p, "]\n"
2170 982:6edb748be064 Chris
    end
2171 980:9b4919de5317 Chris
  end
2172
end
2173
2174 979:56a38a9f6204 Chris
STDIN.each do |line|
2175 975:198f764e734c Chris
2176
  record = parser.parse(line)
2177
2178
  # most annoyingly, the parser can't handle the comma-separated list
2179
  # in X-Forwarded-For where it has more than one element. If it has
2180 983:a97e573d7f87 Chris
  # failed, remove any IP addresses or the word "unknown" with
2181
  # trailing commas and try again
2182 975:198f764e734c Chris
  if not record
2183 983:a97e573d7f87 Chris
    filtered = line.gsub(/(unknown|([0-9]+\.){3}[0-9]+),\s*/, "")
2184 975:198f764e734c Chris
    record = parser.parse(filtered)
2185
  end
2186
2187
  # discard, but count, unparseable lines
2188
  if not record
2189 979:56a38a9f6204 Chris
    print "Line not parseable: ", line, "\n"
2190 975:198f764e734c Chris
    unparseable += 1
2191
    next
2192
  end
2193
2194
  # discard everything that isn't a 200 OK response
2195
  next if record["%>s"] != "200"
2196
2197
  # discard anything apparently requested by a crawler
2198
  next if record["%{User-Agent}i"] =~ /(bot|slurp|crawler|spider|Redmine)\b/i
2199
2200
  # pull out request e.g. GET / HTTP/1.0
2201
  request = record["%r"]
2202
2203
  # split into method, path, protocol
2204
  if not request =~ /^[^\s]+ ([^\s]+) [^\s]+$/
2205 979:56a38a9f6204 Chris
    print "Line not parseable (bad method, path, protocol): ", line, "\n"
2206 975:198f764e734c Chris
    unparseable += 1
2207
    next
2208
  end
2209
2210
  # get the path e.g. /projects/weevilmatic and split on /
2211
  path = $~[1]
2212
  components = path.split("/")
2213
2214
  # should have at least two elements unless path is "/"; first should
2215
  # be empty (begins with /)
2216
  if path != "/" and (components.size < 2 or components[0] != "")
2217 979:56a38a9f6204 Chris
    print "Line not parseable (degenerate path): ", line, "\n"
2218 975:198f764e734c Chris
    unparseable += 1
2219
    next
2220
  end
2221
2222
  if components[1] == "hg"
2223
2224
    # path is /hg/project?something or /hg/project/something
2225
2226
    project = components[2].split("?")[0]
2227 979:56a38a9f6204 Chris
    if not is_public_project?(project)
2228 978:bbb88c44f805 Chris
      next
2229
    end
2230 975:198f764e734c Chris
2231
    if components[2] =~ /&roots=00*$/
2232
      clones[project] += 1
2233
    elsif components[2] =~ /cmd=capabilities/
2234
      pulls[project] += 1
2235 978:bbb88c44f805 Chris
    elsif components[2] =~ /cmd=unbundle/
2236
      pushes[project] += 1
2237 975:198f764e734c Chris
    elsif components[3] == "archive"
2238
      zips[project] += 1
2239
    end
2240
2241
  elsif components[1] == "projects"
2242
2243
    # path is /projects/project or /projects/project/something
2244
2245
    project = components[2]
2246 979:56a38a9f6204 Chris
    project = project.split("?")[0] if project
2247
    if not is_public_project?(project)
2248 978:bbb88c44f805 Chris
      next
2249 975:198f764e734c Chris
    end
2250
2251 978:bbb88c44f805 Chris
    hits[project] += 1
2252
2253 975:198f764e734c Chris
  end
2254
2255
  parseable += 1
2256
end
2257
2258
# Each clone is also a pull; deduct it from the pulls hash, because we
2259
# want that to contain only non-clone pulls
2260
2261
clones.keys.each do |project|
2262
  pulls[project] -= 1
2263
end
2264
2265 982:6edb748be064 Chris
print parseable, " parseable\n"
2266
print unparseable, " unparseable\n"
2267
2268
2269 980:9b4919de5317 Chris
print "\nMercurial clones:\n"
2270
print_stats clones
2271
2272
print "\nMercurial pulls (excluding clones):\n"
2273
print_stats pulls
2274
2275
print "\nMercurial pushes:\n"
2276
print_stats pushes
2277
2278
print "\nMercurial archive (zip file) downloads:\n"
2279
print_stats zips
2280
2281 982:6edb748be064 Chris
print "\nProject page hits (excluding crawlers):\n"
2282 980:9b4919de5317 Chris
print_stats hits
2283 975:198f764e734c Chris
2284
2285 1536:e2a3230f61fa Chris
2286
# Print out an authormap file for hg-to-git conversion using
2287
# hg-fast-export
2288
#
2289
# Invoke with the project identifier as argument, e.g.
2290
#
2291
# ./script/rails runner -e production extra/soundsoftware/get-repo-authormap.rb soundsoftware-site
2292
2293 1537:e55cbb9ba8bf Chris
proj_ident = ARGV.last
2294 1536:e2a3230f61fa Chris
proj = Project.find_by_identifier(proj_ident)
2295
repo = Repository.where(:project_id => proj.id).first
2296
csets = Changeset.where(:repository_id => repo.id)
2297
committers = csets.map do |c| c.committer end.sort.uniq
2298
committers.each do |c|
2299 1537:e55cbb9ba8bf Chris
  if not c =~ /[^<]+<.*@.*>/ then
2300
    u = repo.find_committer_user c
2301
    print "#{c}=#{u.name} <#{u.mail}>\n" unless u.nil?
2302
  end
2303 1536:e2a3230f61fa Chris
end
2304 970:6bd8364eafae luis
2305 1453:b554eb79ec7b luis
# Log user and project information
2306
#
2307
# Invoke with e.g.
2308
#
2309
# ./script/rails runner -e production extra/soundsoftware/get-statistics.rb
2310 970:6bd8364eafae luis
#
2311
2312 1454:02a05da0bedc luis
projectStats =  {
2313
        :all => Project.active.all.count,
2314
        :private => Project.active.find(:all, :conditions => {:is_public => false}).count,
2315
        :top_level => Project.active.find(:all, :conditions => {:parent_id => nil}).count,
2316
        :top_level_and_private => Project.active.find(:all, :conditions => {:is_public => false, :parent_id => nil}).count
2317
      }
2318 970:6bd8364eafae luis
2319 1453:b554eb79ec7b luis
userStats = {:all => User.active.all.count}
2320 1002:f6ede18f3e6e Chris
2321 1453:b554eb79ec7b luis
stats = {:date => Date.today, :projects => projectStats, :users => userStats}.to_json
2322 1002:f6ede18f3e6e Chris
2323 1453:b554eb79ec7b luis
print "#{stats}\n"
2324 1002:f6ede18f3e6e Chris
2325 383:47ae83ce8db8 Chris
<div style="clear: both; float: right"><small><i>Produced by mtree2html by Hartmut Pohlheim</i></small></div>
2326
# configuration file for generation of html-docu from m-files
2327
#
2328
# Author:   Hartmut Pohlheim
2329
# History:  05.11.2000  file created (parameters for mtree2html2001)
2330
#
2331
# The following options/variables must be changed/adapted:
2332
#   dirmfiles
2333
#   dirhtml
2334
#   csslink
2335
#   texttitleframelayout
2336
#   texttitlefiles
2337
#
2338
# The following options/variables should be adapted:
2339
#   authorfile
2340
#   filenametopframe
2341
#   codeheadmeta
2342
2343
#========================================================================
2344
# Variables (possible keywords: set)
2345
# to use the built-in settings, comment the line using # in first column
2346
#========================================================================
2347
2348
#------------------------------------------------------------------------
2349
# dirmfiles: name of directory containing Matlab m-files
2350
# dirhtml: name of directory to place the html-files into
2351
# exthtml: extension used for the html files (.html or .htm)
2352
#          don't forget the point in front of the extension
2353
#------------------------------------------------------------------------
2354
set dirmfiles = .
2355
set dirhtml = doc-output
2356
set exthtml = .html
2357
2358
#------------------------------------------------------------------------
2359
# authorfile:   name of file containing info about author (in html)
2360
#               if defined, this text is included at the bottom of the
2361
#               html files
2362
#------------------------------------------------------------------------
2363 410:675de8e6becf chris
set authorfile = matlab-docs-credit.html
2364 383:47ae83ce8db8 Chris
2365
#------------------------------------------------------------------------
2366
# csslink:   text for linking to css file (style sheets)
2367
#            the text defined here is directly included into the head
2368
#            of the html file
2369
#------------------------------------------------------------------------
2370 410:675de8e6becf chris
#set csslink = <link rel=stylesheet type="text/css" href="CSSFILENAME.css" />
2371 383:47ae83ce8db8 Chris
2372
#------------------------------------------------------------------------
2373
# links2filescase: this is a bit difficult
2374
#                  Matlab is case sensitive on UNIX, but case insensitive
2375
#                  on Windows. Under UNIX Matlab function calls work
2376
#                  only, when the case of file name and function call are
2377
#                  identical, under Windows you can do what you want.
2378
#                  This scripts help you, to keep an exact case in your
2379
#                  project.
2380
#          exact - internal links are only generated, when case of file
2381
#                  name and in source code are identical
2382
#            all - case doesn't matter
2383
#     exactupper - same as exact, additionally links are also vreated to
2384
#                  all upper case function names in source code (often
2385
#                  used by Mathworks)
2386
#      exactvery - same as exact, additionally info about not matching
2387
#                  case is written to screen (stdout), this can be very
2388
#                  helpful in cleaning up the case in a project
2389
#------------------------------------------------------------------------
2390
set links2filescase = all
2391
2392
#------------------------------------------------------------------------
2393
# texttitleframelayout:    text of title for frame layout file (whole docu)
2394
#------------------------------------------------------------------------
2395 389:0bc92382a86b chris
set texttitleframelayout = MATLAB Function Documentation
2396 383:47ae83ce8db8 Chris
2397
#------------------------------------------------------------------------
2398
# texttitle/headerindexalldirs: text of title and header for directory index
2399
#------------------------------------------------------------------------
2400
set texttitleindexalldirs = Index of Directories
2401
set textheaderindexalldirs = Index of Directories
2402
2403
#------------------------------------------------------------------------
2404
# texttitle/headerindex:    text of title and header for index file
2405
#------------------------------------------------------------------------
2406
set texttitleindex = A-Z Index of Functions
2407
set textheaderindex = A-Z Index of Functions
2408
2409
#------------------------------------------------------------------------
2410
# texttitle/headerfiles:    text of title and header for files
2411
#                           name of file will be added at the end
2412
#------------------------------------------------------------------------
2413 389:0bc92382a86b chris
set texttitlefiles = Function
2414 383:47ae83ce8db8 Chris
set textheaderfiles = Documentation of
2415
2416
#------------------------------------------------------------------------
2417
# frames: whether to use frames in layout (yes or no)
2418
#------------------------------------------------------------------------
2419
set frames = no
2420
2421
#------------------------------------------------------------------------
2422
# filenametopframe: name of file including frame layout (highest level file)
2423
# [default: index]
2424
#------------------------------------------------------------------------
2425
set filenametopframe = index
2426
2427
#------------------------------------------------------------------------
2428
# textjumpindexglobal: text displayed for jump to index of all files
2429
#                      (global)
2430
# textjumpindexlocal:  text displayed for jump to index of files in actual
2431
#                      directory (local)
2432
#------------------------------------------------------------------------
2433 389:0bc92382a86b chris
set textjumpindexglobal = <b>Index of</b> all files:
2434
set textjumpindexlocal = this subdirectory only:
2435 383:47ae83ce8db8 Chris
2436
#------------------------------------------------------------------------
2437
# includesource: include source of m-files in documentation [YES|no]
2438
#------------------------------------------------------------------------
2439
set includesource = yes
2440
2441
#------------------------------------------------------------------------
2442
# usecontentsm: use contents.m files as well for structured
2443
#               (hopefully) index [YES|no]
2444
#------------------------------------------------------------------------
2445
set usecontentsm = no
2446
2447
#------------------------------------------------------------------------
2448
# includesource: write/update contents.m files [yes|NO]
2449
#------------------------------------------------------------------------
2450
set writecontentsm = no
2451
2452
#------------------------------------------------------------------------
2453
# processtree:  parse whole directory tree recursively [YES|no]
2454
#------------------------------------------------------------------------
2455
set processtree = yes
2456
2457
#------------------------------------------------------------------------
2458
# producetree:  produce tree for html-files in same structure than
2459
#		          tree of m-files [yes|NO]
2460
#               if no, all files are saved in the same directory, often
2461
#               easier for outside linking to files
2462
#------------------------------------------------------------------------
2463 401:a0f6e994657f chris
set producetree = yes
2464 383:47ae83ce8db8 Chris
2465
#------------------------------------------------------------------------
2466
# codebodyindex/files: HTML-code for adding to BODY tag
2467
#                      can be used for defining colors and
2468
#                      backgroundimages of the files
2469
#                      No longer recommended, use the css file
2470
#------------------------------------------------------------------------
2471
set codebodyindex =
2472
set codebodyfiles =
2473
2474
#------------------------------------------------------------------------
2475
# codeheadmeta: HTML-code added in HEAD area, use for supplying META info
2476
#------------------------------------------------------------------------
2477
set codeheadmeta =
2478
2479
#------------------------------------------------------------------------
2480
# codehr: HTML-code used to define a <HR>, do what you want
2481
#------------------------------------------------------------------------
2482 411:e7ba81c8dc5a chris
set codehr = <hr>
2483 383:47ae83ce8db8 Chris
2484
#------------------------------------------------------------------------
2485
# codeheader: HTML-code added to <H*> tags, use for centering header text
2486
#             or changing the colour/size/font of the header text
2487
#------------------------------------------------------------------------
2488 389:0bc92382a86b chris
set codeheader =
2489 383:47ae83ce8db8 Chris
2490
2491
# End of parameter file
2492 381:2dc8163e9150 Chris
@rem = '--*-Perl-*--';
2493
@rem = '
2494
@echo off
2495
perl -w -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
2496
goto endofperl
2497
@rem ';
2498
# perl -w -S %0.bat "$@"
2499 382:baff1c482d98 Chris
#!/usr/bin/perl
2500 381:2dc8163e9150 Chris
#
2501
# mtree2html_2000 - produce html files from Matlab m-files.
2502
#                   use configuration file for flexibility
2503
#                   can process tree of directories
2504
#
2505
# Copyright (C) 1996-2000 Hartmut Pohlheim.  All rights reserved.
2506
# includes small parts of m2html from Jeffrey C. Kantor 1995
2507
#
2508
# Author:  Hartmut Pohlheim
2509
# History: 06.03.1996  file created
2510
#          07.03.1996  first working version
2511
#          08.03.1996  modularized, help text only once included
2512
#          11.03.1996  clean up, some functions rwritten
2513
#          18.04.1996  silent output with writing in one line only
2514
#                      version 0.20 fixed
2515
#          14.05.1996  start of adding tree structure, could create tree
2516
#          15.05.1996  creating of index files for every directory
2517
#          17.05.1996  first working version except compact A-Z index
2518
#          20.05.1996  cleanup of actual version, more variables and
2519
#                      configurable settings
2520
#          21.05.1996  reading, update and creation of contents.m added
2521
#          22.05.1996  creation of short index started
2522
#          28.05.1996  jump letters for short index,
2523
#                      3 different directory indexes (short/long/contents)
2524
#          29.05.1996  major cleanup, short and long index created from one function
2525
#                      links for HTML and Indexes from 1 function,
2526
#                      version 0.9
2527
#          30.05.1996  contents.m changed to Contents.m (because unix likes it)
2528
#                      function definition can be in first line of m file before comments
2529
#                      version 0.91 fixed
2530
#          03.06.1996  contents file can be written as wanted, the links will be correct
2531
#                      cross references in help block of m-file will be found and
2532
#                      converted, even if the name of the function is written upper case
2533
#                      version 0.92 fixed
2534
#          05.06.1996  construction of dependency matrix changed, is able now to process
2535
#                      even the whole matlab tree (previous version needed to much memory)
2536
#                      removed warning for contents files in different directories
2537
#                      version 0.94 fixed
2538
#          06.06.1996  new link name matrices for ConstructHTMLFile created,
2539
#                      everything is done in ConstructDependencyMatrix,
2540
#                      both dependencies (calls and called) and matrix
2541
#                      with all mentioned names in this m-file, thus, much
2542
#                      less scanning in html construction
2543
#                      script is now (nearly) linear scalable, thus, matlab-toolbox
2544
#                      tree takes less than 1 hour on a Pentium120, with source
2545
#                      version 0.96 fixed
2546
#          10.06.1996  order of creation changed, first all indexes (includes
2547
#                      update/creation of contents.m) and then ConstructDepency
2548
#                      thus, AutoAdd section will be linked as well
2549
#                      excludenames extended, some more common word function names added
2550
#                      version 0.97 fixed
2551
#          17.02.1998  writecontentsm as command line parameter added
2552
#                      error of file not found will even appear when silent
2553
#                      version 1.02
2554
#          21.05.2000  mark comments in source code specially (no fully correct,
2555
#                      can't handle % in strings)
2556
#                      version 1.11
2557
#          05.11.2000  link also to upper and mixed case m-files
2558
#                      searching for .m files now really works (doesn't find grep.com any longer)
2559
#                      file renamed to mtree2html2001
2560
#                      generated html code now all lower case
2561
#                      inclusion of meta-description and meta-keywords in html files
2562
#                      HTML4 compliance done (should be strict HTML4.0, quite near XHTML)
2563
#                      version 1.23
2564
#
2565 383:47ae83ce8db8 Chris
#	   29.03.2011  (Chris Cannam) add frames option.
2566 381:2dc8163e9150 Chris
2567
$VERSION  = '1.23';
2568
($PROGRAM = $0) =~ s@.*/@@; $PROGRAM = "\U$PROGRAM\E";
2569 411:e7ba81c8dc5a chris
$debug = 1;
2570 381:2dc8163e9150 Chris
2571
#------------------------------------------------------------------------
2572
# Define platform specific things
2573
#------------------------------------------------------------------------
2574
# suffix for files to search is defined twice
2575
# the first ($suffix) is for string creation and contains the . as well
2576
# the second ($suffixforsearch) is for regular expression, handling of . is quite special
2577
$suffix = ".m";
2578
$suffixforsearch = "m";
2579
# the directory separator
2580
$dirsep = "/";
2581
# what is the current directory
2582
$diract = ".";
2583
2584
#------------------------------------------------------------------------
2585 382:baff1c482d98 Chris
#  Define all variables and their standard settings
2586 381:2dc8163e9150 Chris
#  documentation of variables is contained in accompanying rc file
2587
#------------------------------------------------------------------------
2588
%var =
2589
(
2590
   'authorfile',                '',
2591
   'codebodyfiles',             '',
2592
   'codebodyindex',             '',
2593
   'codeheadmeta',              '<meta name="author of conversion perl script" content="Hartmut Pohlheim" />',
2594
   'codehr',                    '<hr size="3" noshade="noshade" />',
2595
   'codeheader',                '',
2596 383:47ae83ce8db8 Chris
   'configfile',                'matlab-docs.conf',
2597 381:2dc8163e9150 Chris
   'csslink',                   '',
2598
   'dirmfiles',                 $diract,
2599
   'dirhtml',                   $diract,
2600
   'exthtml',                   '.html',
2601 382:baff1c482d98 Chris
   'frames',                    'yes',
2602 381:2dc8163e9150 Chris
   'filenametopframe',          'index',
2603
   'filenameindexlongglobal',   'indexlg',
2604
   'filenameindexlonglocal',    'indexll',
2605
   'filenameindexshortglobal',  'indexsg',
2606
   'filenameindexshortlocal',   'indexsl',
2607
   'filenameextensionframe',    'f',
2608
   'filenameextensionindex',    'i',
2609
   'filenameextensionjump',     'j',
2610
   'filenamedirshort',          'dirtops',
2611
   'filenamedirlong',           'dirtopl',
2612
   'filenamedircontents',       'dirtopc',
2613
   'includesource',             'yes',
2614
   'links2filescase',           'all',
2615
   'processtree',               'yes',
2616
   'producetree',               'yes',
2617
   'textjumpindexlocal',        'Local Index',
2618
   'textjumpindexglobal',       'Global Index',
2619
   'texttitleframelayout',      'Documentation of Matlab Files',
2620
   'texttitleindexalldirs',     'Index of Directories',
2621
   'textheaderindexalldirs',    'Index of Directories',
2622
   'texttitleindex',            '',
2623
   'textheaderindex',           '',
2624
   'texttitlefiles',            'Documentation of ',
2625
   'textheaderfiles',           'Documentation of ',
2626
   'usecontentsm',              'yes',
2627
   'writecontentsm',            'no'
2628
);
2629
2630
2631
# define all m-file names, that should be excluded from linking
2632
# however, files will still be converted
2633
@excludenames = ( 'all','ans','any','are',
2634
                  'cs',
2635
                  'demo','dos',
2636
                  'echo','edit','else','elseif','end','exist',
2637
                  'flag','for','function',
2638
                  'global',
2639
                  'help',
2640
                  'i','if','inf','info',
2641
                  'j',
2642
                  'more',
2643
                  'null',
2644
                  'return',
2645
                  'script','strings',
2646
                  'what','which','while','who','whos','why',
2647
                );
2648
2649
# Text for inclusion in created HTML/Frame files: Doctype and Charset
2650
$TextDocTypeHTML  = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd">';
2651
$TextDocTypeFrame = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN" "http://www.w3.org/TR/REC-html40/frameset.dtd">';
2652
$TextMetaCharset = '<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />';
2653
2654
#------------------------------------------------------------------------
2655
# Read the command line arguments
2656
#------------------------------------------------------------------------
2657
if (@ARGV == 0) {
2658
   &DisplayHelp()  if &CheckFileName($var{'configfile'}, 'configuration file');
2659
}
2660
2661
# Print provided command line arguments on screen
2662
foreach (@ARGV) { print "   $_\n      "; }
2663
2664
# Get the options
2665
use Getopt::Long;
2666
@options = ('help|h', 'todo|t', 'version|v',
2667
            'authorfile|a=s', 'configfile|c=s', 'dirhtml|html|d=s',
2668
            'dirmfiles|mfiles|m=s', 'includesource|i=s',
2669
            'processtree|r=s', 'producetree|p=s',
2670
            'silent|quiet|q', 'writecontentsm|w=s');
2671
&GetOptions(@options) || die "use -h switch to display help statement\n";
2672
2673
2674
# Display help or todo list, when requested
2675
&DisplayHelp()                         if $opt_help;
2676
&DisplayTodo()                         if $opt_todo;
2677
die "$PROGRAM v$VERSION\n"             if $opt_version;
2678
2679
$exit_status = 0;
2680
2681
#------------------------------------------------------------------------
2682
# Read the config file
2683
#------------------------------------------------------------------------
2684
$var{'configfile'} = $opt_configfile         if $opt_configfile;
2685
&GetConfigFile($var{'configfile'});
2686
2687
2688
#------------------------------------------------------------------------
2689
# Process/Check the command line otions
2690
#------------------------------------------------------------------------
2691
$var{'dirhtml'}   = $opt_dirhtml              if $opt_dirhtml;
2692
if (!(substr($var{'dirhtml'}, -1, 1) eq $dirsep)) { $var{'dirhtml'} = $var{'dirhtml'}.$dirsep; }
2693
$var{'dirmfiles'} = $opt_dirmfiles            if $opt_dirmfiles;
2694
if (!(substr($var{'dirmfiles'}, -1, 1) eq $dirsep)) { $var{'dirmfiles'} = $var{'dirmfiles'}.$dirsep; }
2695
2696
$var{'authorfile'} = $opt_author              if $opt_author;
2697
$var{'includesource'} = $opt_includesource    if $opt_includesource;
2698
if ($var{'includesource'} ne 'no') { $var{'includesource'} = 'yes'; }
2699
$var{'processtree'} = $opt_processtree        if $opt_processtree;
2700
if ($var{'processtree'} ne 'no') { $var{'processtree'} = 'yes'; }
2701
$var{'producetree'} = $opt_producetree        if $opt_producetree;
2702
if ($var{'producetree'} ne 'no') { $var{'producetree'} = 'yes'; }
2703
if ($var{'processtree'} eq 'no') { $var{'producetree'} = 'no'; }
2704 382:baff1c482d98 Chris
if ($var{'frames'} ne 'no') { $var{'frames'} = 'yes'; }
2705 381:2dc8163e9150 Chris
# if (($var{'processtree'} eq 'yes') && ($var{'producetree'} eq 'no')) { $var{'usecontentsm'} = 'no'; }
2706
2707
$var{'writecontentsm'} = $opt_writecontentsm  if $opt_writecontentsm;
2708
2709
#------------------------------------------------------------------------
2710
# Do the real stuff
2711
#------------------------------------------------------------------------
2712
2713
# Print variables on screen, when not silent
2714
&ListVariables                          if !$opt_silent;
2715
2716
# Check the author file
2717
if ($var{'authorfile'} ne '') {
2718 410:675de8e6becf chris
    if (!($var{'authorfile'} =~ m,^/,)) {
2719
	# relative path: treat as relative to config file
2720
	my $cfd = $var{'configfile'};
2721
	$cfd =~ s,/[^/]*$,/,;
2722
	$cfd =~ s,^[^/]*$,.,;
2723
	$var{'authorfile'} = "$cfd/" . $var{'authorfile'};
2724
    }
2725
    if (&CheckFileName($var{'authorfile'}, 'author file')) {
2726
	$var{'authorfile'} = '';
2727
	if (!$opt_silent) { print "   Proceeding without author information!\n"; }
2728
    }
2729 381:2dc8163e9150 Chris
}
2730
2731
# Call the function doing all the real work
2732
&ConstructNameMatrix;
2733
2734
&ConstructDependencyMatrix;
2735
2736
&ConstructAllIndexFiles;
2737
2738
&ConstructHTMLFiles;
2739
2740
exit $exit_status;
2741
2742
#------------------------------------------------------------------------
2743
# Construct list of all mfile names and initialize various data arrays.
2744
#------------------------------------------------------------------------
2745
sub ConstructNameMatrix
2746
{
2747
   local(*MFILE);
2748
   local($file, $dirname);
2749
   local(@newdirectories);
2750
   local(%localnames);
2751
2752
   $RecDeep = 0;
2753
   &ParseTreeReadFiles($var{'dirmfiles'}, $RecDeep);
2754
2755
   foreach $dirname (@directories) {
2756
      if ($dirnumbermfiles{$dirname} > 0) {
2757
         push(@newdirectories, $dirname);
2758
         if (! defined($contentsname{$dirname})) {
2759
            $contentsname{$dirname} = 'Contents';
2760
            if (($var{'writecontentsm'} eq 'no') && ($var{'usecontentsm'} eq 'yes')) {
2761
               print "\r ParseTree - for directory  $dirname  no contents file found!\n";
2762
               print   "             create one or enable writing of contents file (writecontentsm = yes)!\n";
2763
            }
2764
         }
2765
      }
2766
   }
2767
   @alldirectories = @directories;
2768
   @directories = @newdirectories;
2769
2770
   foreach $dirname (@directories) {
2771
      if ($debug > 0) { print "Dir: $dirname \t\t $dirnumbermfiles{$dirname} \t$contentsname{$dirname}\n"; }
2772
   }
2773
2774
   @names = sort(keys %mfile);
2775
2776
   # check, if name of directory is identical to name of file
2777
   @dirsinglenames = values(%dirnamesingle);
2778
   grep($localnames{$_}++, @dirsinglenames);
2779
   @dirandfilename = grep($localnames{$_}, @names);
2780
   if (@dirandfilename) {
2781
      print "\r   Name clash between directory and file name: @dirandfilename\n";
2782
      print   "      These files will be excluded from linking!\n";
2783
      push(@excludenames, @dirandfilename);
2784
   }
2785
2786
   # construct names matrix for help text linking
2787
   #    exclude some common words (and at the same time m-functions) from linking in help text
2788
   grep($localnames{$_}++, @excludenames);
2789
   @linknames = grep(!$localnames{$_}, @names);
2790
2791
   if ($debug > 2) { print "linknames (names of found m-files):\n    @linknames\n"; }
2792
2793
}
2794
2795
#------------------------------------------------------------------------
2796
# Parse tree and collect all Files
2797
#------------------------------------------------------------------------
2798
sub ParseTreeReadFiles
2799
{
2800
   local($dirname, $localRecDeep) = @_;
2801
   local($file, $name, $filewosuffix);
2802
   local($dirhtmlname, $dirmode);
2803
   local($relpath, $relpathtoindex, $replacevardir);
2804
   local(*CHECKDIR, *AKTDIR);
2805
   local(@ALLEFILES);
2806
2807
   opendir(AKTDIR, $dirname) || die "ParseTree - Can't open directory $dirname: $!";
2808
   if ($debug > 1) { print "\nDirectory: $dirname\n"; }
2809
2810
   # create relative path
2811
   $_ = $dirname; $replacevardir = $var{'dirmfiles'};
2812
   s/$replacevardir//; $relpath = $_;
2813
   s/[^\/]+/../g; $relpathtoindex = $_;
2814
2815
   # producetree no
2816
   if ($var{'producetree'} eq 'no') { $relpath = ''; $relpathtoindex = ''; }
2817
2818
   # names of directories (top-level and below top-level m-file-directory)
2819
   push(@directories, $dirname);
2820
   $dirnumbermfiles{$dirname} = 0;    # set number of m-files for this dir to zero
2821
   # relative path from top-level directory, depends on directory name
2822
   $dirnamerelpath{$dirname} = $relpath;
2823
   # relative path from actual directory to top-level directory, depends on directory name
2824
   $dirnamerelpathtoindex{$dirname} = $relpathtoindex;
2825
   # recursion level for directory, depends on directory name
2826
   $dirnamerecdeep{$dirname} = $localRecDeep;
2827
2828
   # only the name of the directory, without path
2829
   $rindexprint = rindex($dirname, $dirsep, length($dirname)-2);
2830
   $rindsub = substr($dirname, $rindexprint+1, length($dirname)-$rindexprint-2);
2831
   $dirnamesingle{$dirname} = $rindsub;
2832
2833
   # create name of html-directories
2834
   $_ = $dirname;
2835
   s/$var{'dirmfiles'}/$var{'dirhtml'}/;
2836
   $dirhtmlname = $_;
2837
   if ($var{'producetree'} eq 'no') { $dirhtmlname = $var{'dirhtml'}; }
2838
   # try to open html directory, if error, then create directory,
2839
   # use same mode as for corresponding m-file directory
2840
   opendir(CHECKDIR,"$dirhtmlname") || do {
2841
      $dirmode = (stat($dirname))[2]; # print "$dirmode\n";
2842
      mkdir("$dirhtmlname", $dirmode) || die ("Cannot create directory $dirhtmlname: $! !");
2843
   };
2844
   closedir(CHECKDIR);
2845
2846
2847
   # read everything from this directory and process them
2848
   @ALLEFILES = readdir(AKTDIR);
2849
2850
   foreach $file (@ALLEFILES) {
2851
      # exclude . and .. directories
2852
      next if $file eq '.';  next if $file eq '..';
2853
2854
      # test for existense of entry (redundant, used for debugging)
2855
      if (-e $dirname.$file) {
2856
         # if it's a directory, call this function recursively
2857
         if (-d $dirname.$file) {
2858
            if ($var{'processtree'} eq 'yes') {
2859
               &ParseTreeReadFiles($dirname.$file.$dirsep, $localRecDeep+1);
2860
            }
2861
         }
2862
         # if it's a file - test for m-file, save name and create some arrays
2863
         elsif (-f $dirname.$file) {
2864
            if ($file =~ /\.$suffixforsearch$/i) {
2865
               # Remove the file suffix to establish the matlab identifiers
2866
               $filewosuffix = $file;
2867
               $filewosuffix =~ s/\.$suffixforsearch$//i;
2868
               # $filename = $name;
2869
2870
               # Contents file in unix must start with a capital letter (Contents.m)
2871
               # ensure, that m-file name is lower case, except the contents file
2872
               if (! ($filewosuffix =~ /^contents$/i)) {
2873 388:dad587ecb8d0 chris
		   # if ($var{'links2filescase'}  eq 'low') { $filewosuffix = "\L$filewosuffix\E"; }
2874 381:2dc8163e9150 Chris
                  $filewosuffixlow = "\L$filewosuffix\E";
2875
               }
2876
               else { $contentsname{$dirname} = $filewosuffix; }
2877
2878
               # internal handle name is always lower case
2879
               $name     = $filewosuffixlow;
2880
               # file name is not lower case
2881
               $filename = $filewosuffix;
2882
2883
               # if don't use C|contents.m, then forget all C|contents.m
2884
               if ($var{'usecontentsm'} eq 'no') { if ($name =~ /contents/i) { next; } }
2885
2886
               # if m-file with this name already exists, use directory and name for name
2887
               # only the first occurence of name will be used for links
2888
               if (defined $mfile{$name}) {
2889
                  if (! ($name =~ /^contents$/i) ) {
2890
                     print "\r ParseTree - Name conflict:  $name in $dirname already exists: $mfile{$name} !\n";
2891
                     print   "             $mfile{$name}  will be used for links!\n";
2892
                  }
2893
                  $name = $dirname.$name;
2894
               }
2895
               # mfile name with path
2896
               $mfile{$name} = $dirname.$file;
2897
               # mfile name (without path)
2898
               $mfilename{$name} = $filename;
2899
               # mfile directory
2900
               $mfiledir{$name} = $dirname;
2901
2902
               # html file name and full path, special extension of Contents files
2903
               if ($name =~ /contents/i) { $extrahtmlfilename = $dirnamesingle{$dirname}; }
2904
               else { $extrahtmlfilename = ''; }
2905
               $hfile{$name} = $dirhtmlname.$mfilename{$name}.$extrahtmlfilename.$var{'exthtml'};
2906
2907
               # save relative html path
2908
               # if ($var{'producetree'} eq 'yes') {
2909
               $hfilerelpath{$name} = $relpath;
2910
               # } else { # if no tree to produce, relative path is empty
2911
               #    $hfilerelpath{$name} = '';
2912
               # }
2913
2914
               # create relative path from html file to directory with global index file
2915
               $hfileindexpath{$name} = $relpathtoindex;
2916
2917
               # Function declaration, if one exists, set default to script
2918
               $synopsis{$name} = "";
2919
               $mtype{$name} = "script";
2920
2921
               # First comment line
2922
               $apropos{$name} = "";
2923
2924
               # count number of m-files in directories
2925
               $dirnumbermfiles{$dirname}++;
2926
2927
               if ($debug > 1) {
2928
                  if ($opt_silent) { print "\r"; }
2929
                  print "   ParseTree: $name \t\t $mfile{$name} \t\t $hfile{$name}\t\t";
2930
                  if (!$opt_silent) { print "\n"; }
2931
               }
2932
            }
2933
         }
2934
         else {
2935
            print "Unknown type of file in $dirname: $file\n";
2936
         }
2937
      }
2938
      else { print "Error: Not existing file in $dirname: $file\n"; }
2939
   }
2940
2941
   closedir(AKTDIR)
2942
2943
}
2944
2945
#------------------------------------------------------------------------
2946
# Construct Dependency matrix
2947
#    $dep{$x,$y} > 0 if $x includes a reference to $y.
2948
#------------------------------------------------------------------------
2949
sub ConstructDependencyMatrix
2950
{
2951
   &ConstructDependencyMatrixReadFiles('all');
2952
   &ConstructDependencyMatrixReally;
2953
}
2954
2955
2956
#------------------------------------------------------------------------
2957
# Construct Dependency matrix
2958
#    $dep{$x,$y} > 0 if $x includes a reference to $y.
2959
#------------------------------------------------------------------------
2960
sub ConstructDependencyMatrixReadFiles
2961
{
2962
   local($whatstring) = @_;
2963
   local(*MFILE);
2964
   local($name, $inames);
2965
   local(%symbolsdep, %symbolsall);
2966
2967
   # Initialize as all zeros.
2968
   # foreach $name (@names) { grep($dep{$name,$_}=0,@names); if ($debug > 0) { print "\r   DepMatrix anlegen: $name\t$#names\t"; } }
2969
2970
   # Compute the dependency matrix
2971
   $inames = -1;
2972
   foreach $name (@names) {
2973
      # Read each file and tabulate the distinct alphanumeric identifiers in
2974
      # an array of symbols. Also scan for:
2975
      #   synopsis: The function declaration line
2976
      #   apropos:  The first line of the help text
2977
2978
      # look for whatstring, if all: process every file, if contents: process only contents files
2979
      if ($whatstring eq 'contents') { if (! ($name =~ /contents$/i) ) { next; } }
2980
      elsif ($whatstring eq 'all') { }    # do nothing
2981
      else { print "\r   ConstructDependency: Unknown parameter whatstring: $whatstring \n"; }
2982
2983
      undef %symbolsall; undef %symbolsdep;
2984
      open(MFILE,"<$mfile{$name}") || die("Can't open $mfile{$name}: $!\n");
2985
      while (<MFILE>) {
2986
         chop;
2987
2988
         # Split on nonalphanumerics, then look for all words, used for links later
2989
         # this one for all references
2990
         @wordsall = grep(/[a-zA-Z]\w*/, split('\W',$_));
2991
         # set all words to lower case for link checking
2992
         undef @wordsall2;
2993
         # do case conversion not, case checking is done later
2994
         foreach (@wordsall) { push(@wordsall2, "\L$_\E"); }
2995
         # @wordsall2 = @wordsall;
2996
         grep($symbolsall{$_}++, @wordsall2);
2997
2998
         # Store first comment line, skip all others.
2999
         if (/^\s*%/) {
3000
            if (!$apropos{$name}) {
3001
               s/^\s*%\s*//;   # remove % and leading white spaces on line
3002
               $_ = &SubstituteHTMLEntities($_);
3003
               $apropos{$name} = $_;
3004
            }
3005
            next;
3006
         }
3007
3008
         # If it's the function declaration line, then store it and skip
3009
         # but only, when first function definition (multiple function lines when private subfunctions in file
3010
         if ($synopsis{$name} eq '') {
3011
            if (/^\s*function/) {
3012
               s/^\s*function\s*//;
3013
               $synopsis{$name} = $_;
3014
               $mtype{$name} = "function";
3015
               next;
3016
            }
3017
         }
3018
3019
         # Split off any trailing comments
3020
         if ($_ ne '') {
3021
            # this one for references in program code only
3022
            # when syntax parsing, here is a working place
3023
            ($statement) = split('%',$_,1);
3024
            @wordsdep = grep(/[a-zA-Z]\w*/,split('\W',$statement));
3025
            # do case conversion not, case checking is done later
3026
            undef @wordsdep2;
3027
            foreach (@wordsdep) { push(@wordsdep2, "\L$_\E"); }
3028
            grep($symbolsdep{$_}++, @wordsdep2);
3029
         }
3030
      }
3031
      close MFILE;
3032
3033
      # compute intersection between %symbolsall and @linknames
3034
      delete($symbolsall{$name});
3035
      # foreach $localsumall ($symbolsall) {
3036
      #    $localsumall = "\L$localsumall\E";
3037
      # }
3038
      @{'all'.$name} = grep($symbolsall{$_}, @linknames);
3039
3040
      # compute intersection between %symbolsdep and @linknames
3041
      delete($symbolsdep{$name});
3042
      @{'depcalls'.$name} = grep($symbolsdep{$_}, @linknames);
3043
3044
      $inames++; print "\r   DepCallsMatrix: $inames/$#names\t $name\t";
3045
      if ($debug > 2) { print "\n      depnames: @{'depcalls'.$name}\n      all: @{'all'.$name}\n"; }
3046
   }
3047
}
3048
3049
3050
#------------------------------------------------------------------------
3051
# Construct Dependency matrix
3052
#    $dep{$x,$y} > 0 if $x includes a reference to $y.
3053
#------------------------------------------------------------------------
3054
sub ConstructDependencyMatrixReally
3055
{
3056
   local($inames, $name);
3057
3058
   $inames = -1;
3059
   foreach $name (@names) { undef %{'depint'.$name}; }
3060
   foreach $name (@names) {
3061
      grep(${'depint'.$_}{$name}++, @{'depcalls'.$name});
3062
      $inames++; print "\r   DepCalledMatrix1: $inames/$#names\t $name\t";
3063
   }
3064
   $inames = -1;
3065
   foreach $name (@names) {
3066
      # compute intersection between %depint.name{$_} and @linknames
3067
      if (defined (%{'depint'.$name})) { @{'depcalled'.$name} = grep(${'depint'.$name}{$_}, @linknames); }
3068
      $inames++; print "\r   DepCalledMatrix2: $inames/$#names\t $name\t";
3069
      if ($debug > 2) { print "\n      depcalled: @{'depcalled'.$name}\n"; }
3070
   }
3071
3072
}
3073
3074
3075
#========================================================================
3076
# Construct all index files
3077
#========================================================================
3078
sub ConstructAllIndexFiles
3079
{
3080
   local(@localnames);
3081
   local($ActDir);
3082
   local($name);
3083
3084
   # define variables and names for frame target
3085
   $GlobalNameFrameMainLeft = 'Cont_Main';
3086
   $GlobalNameFrameMainRight = 'Cont_Lower';
3087
   $GlobalNameFrameAZIndexsmall = 'IndexAZindex';
3088
   $GlobalNameFrameAZIndexjump = 'IndexAZjump';
3089
3090
   $indexcreated = 0;
3091
3092
   &ConstructHighestIndexFile;
3093
   $indexcreated++;
3094
3095
   # if ($var{'producetree'} eq 'yes') {
3096
      # moved next 2 lines out of if for producetree no
3097
      # &ConstructHighestIndexFile;
3098
      # $indexcreated++;
3099
3100
      foreach $ActDir (@directories) {
3101
         undef @localnames;
3102
         foreach $name (@names) {
3103
            local($pathsubstr) = substr($mfile{$name}, 0, rindex($mfile{$name}, "/")+1);
3104
            if ($ActDir eq $pathsubstr) {
3105
               if ($debug > 1) { print "IndexFile: $pathsubstr    ActDir: $ActDir   Hfilerelpath: $hfilerelpath{$name}\n"; }
3106
               push(@localnames, $name);
3107
            }
3108
         }
3109
         if ($debug > 2) { print "localnames: @localnames\n"; }
3110
         # create contents file and short|long index of files in local directory
3111
         &ConstructContentsmFile($ActDir, @localnames);
3112
         &ConstructAZIndexFile($ActDir, 'short', 'local', @localnames);
3113
         &ConstructAZIndexFile($ActDir, 'long', 'local', @localnames);
3114
         $indexcreated+=2;
3115
      }
3116
   # } else {
3117
   #    &ConstructContentsmFile($var{'dirmfiles'}, @names);
3118
   # }
3119
3120
   # create short|long index of files in all directory
3121
   &ConstructAZIndexFile($var{'dirmfiles'}, 'short', 'global', @names);
3122
   &ConstructAZIndexFile($var{'dirmfiles'}, 'long', 'global', @names);
3123
   $indexcreated+=2;
3124
3125
   # if contents.m were created or updated, the dependency matrices should
3126
   # be updated as well
3127
   if ($var{'writecontentsm'} eq 'yes') { &ConstructDependencyMatrixReadFiles('contents');; }
3128
}
3129
3130
3131
#========================================================================
3132
# Construct the highest level index file
3133
#========================================================================
3134
sub ConstructHighestIndexFile
3135
{
3136
   local(*IFILE);
3137
   local($indexfile, $filename);
3138
3139
   # Build the frame layout file, this files includes the layout of the frames
3140
   # Build the frame layout file name (highest one)
3141
   $indexfile = $var{'dirhtml'}.$var{'filenametopframe'}.$var{'exthtml'};
3142
3143 382:baff1c482d98 Chris
   if ($var{'frames'} eq 'yes') {
3144 381:2dc8163e9150 Chris
3145 382:baff1c482d98 Chris
       open(IFILE,">$indexfile") || die("Cannot open frame layout file $indexfile\n");
3146 381:2dc8163e9150 Chris
3147 382:baff1c482d98 Chris
       # Write the header of frame file
3148
       print IFILE "$TextDocTypeFrame\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n";
3149
       print IFILE "   <title>$var{'texttitleframelayout'}</title>\n";
3150
       print IFILE "</head>\n";
3151 381:2dc8163e9150 Chris
3152 382:baff1c482d98 Chris
       # definition of 2 frames, left the tree of directories,
3153
       # right the index of that directory or the docu of a file
3154
       print IFILE "<frameset  cols=\"25%,75%\">\n";
3155
       print IFILE "   <frame src=\"$var{'filenamedirshort'}$var{'exthtml'}\" name=\"$GlobalNameFrameMainLeft\" />\n";
3156
       print IFILE "   <frame src=\"$var{'filenameindexshortglobal'}$var{'filenameextensionframe'}$var{'exthtml'}\" name=\"$GlobalNameFrameMainRight\" />\n";   print IFILE "</frameset>\n";
3157 381:2dc8163e9150 Chris
3158 382:baff1c482d98 Chris
       print IFILE "</html>\n";
3159
3160
       close(IFILE);
3161
3162
       if ($opt_silent) { print "\r"; }
3163
       print "   Frame layout file created: $indexfile\t";
3164
       if (!$opt_silent) { print "\n"; }
3165
   }
3166 381:2dc8163e9150 Chris
3167
   for($irun=0; $irun <= 2; $irun++) {
3168
      # Build the top directory index file, these files include the directory tree
3169
      # Build the directory tree index file name
3170
3171
      # Create no directory file for contents, when no contents to use
3172
      if (($irun == 2) && ($var{'usecontentsm'} eq 'no')) { next; }
3173
3174
      # Assign the correct index file name
3175
      if ($irun == 0) { $filename = $var{'filenamedirshort'}; }
3176
      elsif ($irun == 1) { $filename = $var{'filenamedirlong'}; }
3177
      elsif ($irun == 2) { $filename = $var{'filenamedircontents'}; }
3178
3179
      $indexfile = $var{'dirhtml'}.$filename.$var{'exthtml'};
3180
3181
      open(IFILE,">$indexfile") || die("Cannot open directory tree index file $indexfile\n");
3182
      # Write header of HTML file
3183
      print IFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3184
3185
      if ($var{'texttitleindexalldirs'} eq '') {
3186
         print IFILE "<title>Index of Directories of $var{'dirmfiles'}</title>\n";
3187
      } else {
3188
         print IFILE "<title>$var{'texttitleindexalldirs'}</title>\n";
3189
      }
3190 382:baff1c482d98 Chris
3191
      if ($var{'frames'} eq 'yes') {
3192
	  print IFILE "<base target=\"$GlobalNameFrameMainRight\" />\n";
3193
      }
3194
3195 381:2dc8163e9150 Chris
      print IFILE "</head>\n";
3196
      print IFILE "<body $var{'codebodyindex'}>\n";
3197 410:675de8e6becf chris
      print IFILE "<div id=\"matlabdoc\">\n";
3198 381:2dc8163e9150 Chris
      if ($var{'textheaderindexalldirs'} eq '') {
3199
         print IFILE "<h1 $var{'codeheader'}>Index of Directories of <em>$var{'dirmfiles'}</em></h1>\n";
3200
      } else {
3201
         print IFILE "<h1 $var{'codeheader'}>$var{'textheaderindexalldirs'}</h1>\n";
3202
      }
3203 389:0bc92382a86b chris
      print IFILE "<p>\n";
3204 382:baff1c482d98 Chris
3205
      if ($var{'frames'} eq 'yes') {
3206
	  if ($irun == 0) { print IFILE "<strong>short</strong>\n"; }
3207
	  else { print IFILE "<a href=\"$var{'filenamedirshort'}$var{'exthtml'}\" target=\"$GlobalNameFrameMainLeft\">short</a>\n"; }
3208
	  if ($irun == 1) { print IFILE " | <strong>long</strong>\n"; }
3209
	  else { print IFILE " | <a href=\"$var{'filenamedirlong'}$var{'exthtml'}\" target=\"$GlobalNameFrameMainLeft\">long</a>\n"; }
3210
	  if ($var{'usecontentsm'} eq 'yes') {
3211
	      if ($irun == 2) { print IFILE " | <strong>contents</strong>\n"; }
3212
	      else { print IFILE " | <a href=\"$var{'filenamedircontents'}$var{'exthtml'}\" target=\"$GlobalNameFrameMainLeft\">contents</a>\n"; }
3213
	  }
3214
      } else {
3215
	  if ($irun == 0) { print IFILE "<strong>short</strong>\n"; }
3216
	  else { print IFILE "<a href=\"$var{'filenamedirshort'}$var{'exthtml'}\">short</a>\n"; }
3217
	  if ($irun == 1) { print IFILE " | <strong>long</strong>\n"; }
3218
	  else { print IFILE " | <a href=\"$var{'filenamedirlong'}$var{'exthtml'}\">long</a>\n"; }
3219
	  if ($var{'usecontentsm'} eq 'yes') {
3220
	      if ($irun == 2) { print IFILE " | <strong>contents</strong>\n"; }
3221
	      else { print IFILE " | <a href=\"$var{'filenamedircontents'}$var{'exthtml'}\">contents</a>\n"; }
3222
	  }
3223 381:2dc8163e9150 Chris
      }
3224
3225
      print IFILE "</p><br />\n\n";
3226
      print IFILE "<ul>\n";
3227
3228
      # go through all directories and create a list entry for each one,
3229
      # depending on recursion level create sublists
3230
      $prevrecdeeplevel = 0;
3231
      foreach $name (@alldirectories) {
3232
         $actrecdeeplevel = $dirnamerecdeep{$name};
3233
         for( ; $prevrecdeeplevel < $actrecdeeplevel; $prevrecdeeplevel++ ) { print IFILE "<ul>\n"; }
3234
         for( ; $prevrecdeeplevel > $actrecdeeplevel; $prevrecdeeplevel-- ) { print IFILE "</ul>\n"; }
3235
         if ($irun == 0) { $indexfilenameused = $var{'filenameindexshortlocal'}.$var{'filenameextensionframe'}; }
3236
         elsif ($irun == 1) { $indexfilenameused = $var{'filenameindexlonglocal'}.$var{'filenameextensionframe'}; }
3237
         elsif ($irun == 2) { $indexfilenameused = $contentsname{$name}; }
3238
         else { die "ConstructHighestIndexFile: Unknown value of irun"; }
3239
         if ($dirnumbermfiles{$name} > 0) {
3240
            # producetree no
3241
            # if ($var{'producetree'} eq 'no') { $dirnamehere = ''; }
3242
            # else { $dirnamehere = '$dirnamerelpath{$name}'; }
3243
            # print IFILE "<LI><A HREF=\"$dirnamehere$indexfilenameused_$dirnamesingle{$name}$var{'exthtml'}\">$dirnamesingle{$name}</A>\n";
3244
            print IFILE "<li><a href=\"$dirnamerelpath{$name}$indexfilenameused$dirnamesingle{$name}$var{'exthtml'}\">$dirnamesingle{$name}</a></li>\n";
3245
         } else {
3246
            # print directories with no m-files inside not
3247
            # print IFILE "<li>$dirnamesingle{$name}</li>\n";
3248
         }
3249
      }
3250
      $actrecdeeplevel = 0;
3251
      for( ; $prevrecdeeplevel > $actrecdeeplevel; $prevrecdeeplevel-- ) { print IFILE "</ul>\n"; }
3252
      print IFILE "</ul>\n<br />$var{'codehr'}\n";
3253
3254
      # Include info about author from authorfile
3255
      &WriteFile2Handle($var{'authorfile'}, IFILE);
3256
3257
      print IFILE "<!--navigate-->\n";
3258
      print IFILE "<!--copyright-->\n";
3259 410:675de8e6becf chris
      print IFILE "</div>\n</body>\n</html>\n";
3260 381:2dc8163e9150 Chris
3261
      close(IFILE);
3262
3263
      if ($opt_silent) { print "\r"; }
3264
      print "   Directory - Indexfile created: $indexfile\t";
3265
      if (!$opt_silent) { print "\n"; }
3266
   }
3267
}
3268
3269
3270
#========================================================================
3271
# Construct the A-Z index file (global/local and/or short/long)
3272
#========================================================================
3273
sub ConstructAZIndexFile
3274
{
3275
   local($LocalActDir, $LocalShortLong, $LocalGlobalLocal, @localnames) = @_;
3276
   local(*IFILE);
3277
   local($name, $indexfilename, $dirpath);
3278
   local($firstletter, $firstone);
3279
3280
   if ($debug > 2) { print "localnames in AZ small: @localnames\n"; print "     ActDir in A-Z: $LocalActDir\n"; }
3281
3282
   # extract filename of index file from parameters of function
3283
   if ($LocalShortLong eq 'short') {
3284
      if ($LocalGlobalLocal eq 'global') { $indexfilename = $var{'filenameindexshortglobal'}; }
3285
      elsif ($LocalGlobalLocal eq 'local') { $indexfilename = $var{'filenameindexshortlocal'}; }
3286
      else { die "wrong parameter for LocalGlobalLocal in ConstructAZIndexFile: $LocalGlobalLocal."; }
3287
   } elsif ($LocalShortLong eq 'long') {
3288
      if ($LocalGlobalLocal eq 'global') { $indexfilename = $var{'filenameindexlongglobal'}; }
3289
      elsif ($LocalGlobalLocal eq 'local') { $indexfilename = $var{'filenameindexlonglocal'}; }
3290
      else { die "wrong parameter for LocalGlobalLocal in ConstructAZIndexFile: $LocalGlobalLocal."; }
3291
   } else { die "wrong parameter for LocalShortLong in ConstructAZIndexFile: $LocalShortLong."; }
3292
3293
   # producetree no
3294
   # if ($var{'producetree'} eq 'no') { $dirnamehere = ''; }
3295
   # else { $dirnamehere = '$dirnamerelpath{$LocalActDir}'; }
3296
   # Build the index file name
3297
   # handle the global index file case separately (no extra directory name in file)
3298
   #    the local index file name must be extended by the name of the directory
3299
   if ($LocalGlobalLocal eq 'global') { $extradirfilename = ''; }
3300
   else { $extradirfilename = $dirnamesingle{$LocalActDir}; }
3301
   $indexfile = $var{'dirhtml'}.$dirnamerelpath{$LocalActDir}.$indexfilename.$var{'filenameextensionindex'}.$extradirfilename.$var{'exthtml'};
3302 382:baff1c482d98 Chris
3303 401:a0f6e994657f chris
   if ($LocalShortLong eq 'short' and $extradirfilename eq '' and $var{'frames'} ne 'yes') {
3304
       # With no frames and no subdir path, this must go in the
3305
       # top-level index file instead
3306 382:baff1c482d98 Chris
       $indexfile = $var{'dirhtml'}.$var{'filenametopframe'}.$var{'exthtml'};
3307
   }
3308
3309 381:2dc8163e9150 Chris
   if ($debug > 2) { print "   indexfilename (a-z small): $indexfile\n"; }
3310
3311
   open(IFILE,">$indexfile") || die("Cannot open index file $indexfile: $!\n");
3312
3313
   # Write the header of HTML file
3314
   print IFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3315
3316 410:675de8e6becf chris
   my $dirToPrint = $LocalActDir;
3317
   $dirToPrint =~ s,^./,,;
3318
3319 381:2dc8163e9150 Chris
   if ($var{'texttitleindex'} eq '') {
3320 410:675de8e6becf chris
      print IFILE "<title>Index of Matlab Files in Directory $dirToPrint</title>\n";
3321 381:2dc8163e9150 Chris
   } else {
3322
      if ($LocalGlobalLocal eq 'global') { print IFILE "<title>$var{'texttitleindex'}</title>\n"; }
3323 410:675de8e6becf chris
      else { print IFILE "<title>$var{'texttitleindex'} in Directory $dirToPrint</title>\n"; }
3324 381:2dc8163e9150 Chris
   }
3325 382:baff1c482d98 Chris
3326
   if ($var{'frames'} eq 'yes') {
3327
       print IFILE "<base target=\"$GlobalNameFrameMainRight\" />\n";
3328
   }
3329 381:2dc8163e9150 Chris
   print IFILE "</head>\n";
3330 382:baff1c482d98 Chris
3331 381:2dc8163e9150 Chris
   print IFILE "<body $var{'codebodyindex'}>\n";
3332 410:675de8e6becf chris
   print IFILE "<div id=\"matlabdoc\">\n";
3333 381:2dc8163e9150 Chris
   if ($var{'textheaderindex'} eq '') {
3334 410:675de8e6becf chris
      print IFILE "<h1 $var{'codeheader'}>Index of Matlab Files in Directory $dirToPrint</h1>\n";
3335 381:2dc8163e9150 Chris
   } else {
3336
      if ($LocalGlobalLocal eq 'global') { print IFILE "<h1 $var{'codeheader'}>$var{'textheaderindex'}</h1>\n"; }
3337 410:675de8e6becf chris
      else { print IFILE "<h1 $var{'codeheader'}>$var{'textheaderindex'} in Directory $dirToPrint</h1>\n"; }
3338 381:2dc8163e9150 Chris
   }
3339
3340
   # include links to indexes
3341
   &ConstructLinks2Index(IFILE, $dirnamerelpathtoindex{$LocalActDir}, $LocalActDir, $LocalGlobalLocal);
3342
3343
   # Collect the starting letters of m files in this directory or all m-files
3344
   for('a'..'z') { undef @{$_}; }
3345
   foreach $name (@localnames) {
3346
      if (! ($mfilename{$name} =~ /contents/i)) {
3347
         $firstletter = substr($mfilename{$name}, 0, 1);
3348
         # convert first letter always to lower case
3349
         # needed for reference to lower and upper case m-files
3350
         $firstletter = "\L$firstletter\E";
3351
         push(@{$firstletter}, $name);
3352
      }
3353
   }
3354
3355
   if ($LocalShortLong eq 'short') {
3356
      # begin create short index
3357
      print IFILE "<table width=\"100%\">\n";
3358
3359
      for('a'..'z') {
3360
         # print "   $_: @{$_}\n";
3361
         $numberofletter = $#{$_}+1;
3362 410:675de8e6becf chris
	 $cols = 3;
3363 381:2dc8163e9150 Chris
         if ($numberofletter > 0) {
3364 410:675de8e6becf chris
            print IFILE "\n<tr><td><br/><strong><a name=\"\U$_\E$_\"></a><span class=\"an\">\U$_\E</span></strong></td></tr>\n";
3365
            for ($count = 0; $count < $numberofletter; $count++) {
3366
		if (($count % $cols) == 0) {
3367
		    if ($count > 0) {
3368
			print IFILE "</tr><tr>\n";
3369
		    }
3370
		    print IFILE "<tr><td></td>";
3371
		}
3372
		$name = @{$_}[$count];
3373
		if ($LocalGlobalLocal eq 'global') { $dirpath = $hfilerelpath{$name}; } else { $dirpath = ""; }
3374
		print IFILE "<td><a href=\"$dirpath$mfilename{$name}$var{'exthtml'}\">$mfilename{$name}</a></td>";
3375
	    }
3376
3377
	    print IFILE "</tr>\n";
3378
3379
            # $numberhalf = ($numberofletter + 1 - (($numberofletter+1) % 2))/2;
3380
            # if ($debug > 2) { print "   $_: @{$_} \t $numberhalf \t $numberofletter\n"; }
3381
            # for($count = 0; $count < $numberhalf; $count++) {
3382
            #    $name = @{$_}[$count];
3383
            #    if ($LocalGlobalLocal eq 'global') { $dirpath = $hfilerelpath{$name}; } else { $dirpath = ""; }
3384
            #    print IFILE "<tr><td width=\"50%\"><a href=\"$dirpath$mfilename{$name}$var{'exthtml'}\">$mfilename{$name}</a></td>";
3385
            #    if (($count + $numberhalf) < $numberofletter) {
3386
            #       $name = @{$_}[$count + $numberhalf];
3387
            #       if ($LocalGlobalLocal eq 'global') { $dirpath = $hfilerelpath{$name}; } else { $dirpath = ""; }
3388
            #       print IFILE "<td width=\"50%\"><a href=\"$dirpath$mfilename{$name}$var{'exthtml'}\">$mfilename{$name}</a></td></tr>\n";
3389
            #    } else {
3390
            #       print IFILE "<td width=\"50%\"></td></tr>\n";
3391
            #    }
3392
            # }
3393 381:2dc8163e9150 Chris
         }
3394
      }
3395
      print IFILE "</table>\n<br />$var{'codehr'}\n";
3396
3397
   } elsif ($LocalShortLong eq 'long') {
3398
      # begin create long index
3399 410:675de8e6becf chris
      print IFILE "<table width=\"100%\">\n";
3400 401:a0f6e994657f chris
      print IFILE "<tr><th>Name</th><th>Synopsis</th></tr>\n";
3401 381:2dc8163e9150 Chris
3402
      for('a'..'z') {
3403
         # print "   $_: @{$_}\n";
3404
         $numberofletter = $#{$_}+1;
3405
         if ($numberofletter > 0) {
3406
            $firstone = 1;
3407
            foreach $name (@{$_}) {
3408
               if ($debug > 1) { print "   AZinforeach1: $name \t\t $hfilerelpath{$name} \t\t $dirnamerelpath{$LocalActDir}\n"; }
3409
               if ($LocalGlobalLocal eq 'global') { $dirpath = $hfilerelpath{$name}; } else { $dirpath = ""; }
3410
               if (! ($mfilename{$name} =~ /contents/i)) {
3411 400:4ad6499d7998 chris
                  if ($firstone == 1) { print IFILE "\n<tr><td colspan=\"2\"><br /><strong><a name=\"\U$_\E$_\"></a><span class=\"an\">\U$_\E</span></strong></td></tr>\n"; $firstone = 0; }
3412 381:2dc8163e9150 Chris
                  print IFILE "<tr><td valign=\"top\"><a href=\"$dirpath$mfilename{$name}$var{'exthtml'}\">$mfilename{$name}</a></td><td>$apropos{$name}</td></tr>\n";
3413
               }
3414
            }
3415
         }
3416
      }
3417
      print IFILE "</table>\n<br />$var{'codehr'}\n";
3418
   } else { die "wrong parameter for LocalShortLong in ConstructAZIndexFile: $LocalShortLong."; }
3419
3420
   # Include info about author from authorfile
3421
   &WriteFile2Handle($var{'authorfile'}, IFILE);
3422
3423
   print IFILE "<!--navigate-->\n";
3424
   print IFILE "<!--copyright-->\n";
3425 410:675de8e6becf chris
   print IFILE "</div>\n</body>\n</html>\n";
3426 381:2dc8163e9150 Chris
3427
   close(IFILE);
3428
3429
   if ($opt_silent) { print "\r"; }
3430
   print "   Indexfile small (A-Z) created: $indexfile\t";
3431
   if (!$opt_silent) { print "\n"; }
3432
3433
3434
   # Build the A-Z jump index file name
3435
   # handle the global index file case separately (no extra directory name in file)
3436
   if ($LocalGlobalLocal eq 'global') { $extradirfilename = ''; }
3437
   else { $extradirfilename = $dirnamesingle{$LocalActDir}; }
3438
3439 382:baff1c482d98 Chris
   if ($var{'frames'} eq 'yes') {
3440
3441
       $indexfile = $var{'dirhtml'}.$dirnamerelpath{$LocalActDir}.$indexfilename.$var{'filenameextensionjump'}.$extradirfilename.$var{'exthtml'};
3442
       if ($debug > 2) { print "   indexfilename (a-z jump): $indexfile\n"; }
3443
       open(IFILE,">$indexfile") || die("Cannot open jump index file $indexfile: $!\n");
3444
3445
       # Write the header of HTML file
3446
       print IFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3447
3448
       if ($var{'texttitleindex'} eq '') {
3449 410:675de8e6becf chris
	   print IFILE "<title>A-Z jump index in directory $dirToPrint</title>\n";
3450 382:baff1c482d98 Chris
       } else {
3451
	   if ($LocalGlobalLocal eq 'global') { print IFILE "<title>$var{'texttitleindex'}</title>\n"; }
3452 410:675de8e6becf chris
	   else { print IFILE "<title>$var{'texttitleindex'} in Directory $dirToPrint</title>\n"; }
3453 382:baff1c482d98 Chris
       }
3454
3455
       if ($var{'frames'} eq 'yes') {
3456
	   print IFILE "<base target=\"$GlobalNameFrameAZIndexsmall\" />\n";
3457
       }
3458
       print IFILE "</head>\n";
3459
       print IFILE "<body $var{'codebodyindex'}>\n";
3460 410:675de8e6becf chris
       print IFILE "<div id=\"matlabdoc\">\n";
3461 382:baff1c482d98 Chris
3462
       # Write the A-Z jump line, generate link for letters with files starting with this letter
3463
       # and only letters for no files starting with this letter
3464
       # use previously generated arrays with names of files sorted by starting letter
3465
       for('a'..'z') {
3466
	   $numberofletter = $#{$_}+1;
3467
	   if ($numberofletter > 0) {
3468
	       print IFILE "<strong><a href=\"$indexfilename$var{'filenameextensionindex'}$extradirfilename$var{'exthtml'}#\U$_\E$_\">\U$_\E</a> </strong>\n";
3469
	   } else {
3470
	       print IFILE "\U$_\E \n";
3471
	   }
3472
       }
3473
3474 410:675de8e6becf chris
       print IFILE "</div></body>\n</html>\n";
3475 382:baff1c482d98 Chris
3476
       close(IFILE);
3477
3478
       if ($opt_silent) { print "\r"; }
3479
       print "   Indexfile small (A-Z jump) created: $indexfile\t";
3480
       if (!$opt_silent) { print "\n"; }
3481 381:2dc8163e9150 Chris
   }
3482
3483
3484
   # Build the frame layout file, this file includes the layout of the frames
3485
   # Build the frame layout file name (for small/compact A-Z index)
3486
   # handle the global index file case separately (no extra directory name in file)
3487
   if ($LocalGlobalLocal eq 'global') { $extradirfilename = ''; }
3488
   else { $extradirfilename = $dirnamesingle{$LocalActDir}; }
3489
3490 382:baff1c482d98 Chris
   if ($var{'frames'} eq 'yes') {
3491 381:2dc8163e9150 Chris
3492 382:baff1c482d98 Chris
       $indexfile = $var{'dirhtml'}.$dirnamerelpath{$LocalActDir}.$indexfilename.$var{'filenameextensionframe'}.$extradirfilename.$var{'exthtml'};
3493
       if ($debug > 2) { print "   indexfilename (a-z frame): $indexfile\n"; }
3494 381:2dc8163e9150 Chris
3495 382:baff1c482d98 Chris
       open(IFILE,">$indexfile") || die("Cannot open jump index frame file $indexfile: $!\n");
3496
3497
       # Write the header of Frame file
3498
       print IFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3499
3500
       if ($var{'texttitleindex'} eq '') {
3501 410:675de8e6becf chris
	   print IFILE "<title>Index of Matlab Files in Directory $dirToPrint</title>\n";
3502 382:baff1c482d98 Chris
       } else {
3503
	   if ($LocalGlobalLocal eq 'global') { print IFILE "<title>$var{'texttitleindex'}</title>\n"; }
3504 410:675de8e6becf chris
	   else { print IFILE "<title>$var{'texttitleindex'} in Directory $dirToPrint</title>\n"; }
3505 382:baff1c482d98 Chris
       }
3506
       print IFILE "</head>\n";
3507
3508
       # definition of 2 frames, top the A-Z index, below the jump letter line
3509
       print IFILE "<frameset  rows=\"90%,10%\">\n";
3510
       print IFILE "   <frame src=\"$indexfilename$var{'filenameextensionindex'}$extradirfilename$var{'exthtml'}\" name=\"$GlobalNameFrameAZIndexsmall\" />\n";
3511
       print IFILE "   <frame src=\"$indexfilename$var{'filenameextensionjump'}$extradirfilename$var{'exthtml'}\" name=\"$GlobalNameFrameAZIndexjump\" />\n";
3512
       print IFILE "</frameset>\n";
3513
3514
       print IFILE "</html>\n";
3515
3516
       close(IFILE);
3517
3518
       if ($opt_silent) { print "\r"; }
3519
       print "   Frame layout file created: $indexfile\t";
3520
       if (!$opt_silent) { print "\n"; }
3521 381:2dc8163e9150 Chris
   }
3522
}
3523 382:baff1c482d98 Chris
3524 381:2dc8163e9150 Chris
3525
#========================================================================
3526
# Construct the links to all indexes
3527
#========================================================================
3528
sub ConstructLinks2Index
3529
{
3530
   local(*WRITEFILE, $LocalPath2Index, $PathContents, $LocalGlobalLocal) = @_;
3531
3532
   # include links to short/long - local/global index and C|contents.m
3533 389:0bc92382a86b chris
   print WRITEFILE "\n<p>";
3534
   print WRITEFILE "$var{'textjumpindexglobal'} ";
3535 382:baff1c482d98 Chris
3536
   if ($var{'frames'} eq 'yes') {
3537
       print WRITEFILE "<a href=\"$LocalPath2Index$var{'filenameindexshortglobal'}$var{'filenameextensionframe'}$var{'exthtml'}\">short</a> | ";
3538 389:0bc92382a86b chris
       print WRITEFILE "<a href=\"$LocalPath2Index$var{'filenameindexlongglobal'}$var{'filenameextensionframe'}$var{'exthtml'}\">long</a>\n";
3539 382:baff1c482d98 Chris
   } else {
3540 387:f89765996ef9 Chris
       print WRITEFILE "<a href=\"$LocalPath2Index$var{'filenametopframe'}$var{'exthtml'}\">short</a> | ";
3541 389:0bc92382a86b chris
       print WRITEFILE "<a href=\"$LocalPath2Index$var{'filenameindexlongglobal'}$var{'filenameextensionindex'}$var{'exthtml'}\">long</a>\n";
3542 382:baff1c482d98 Chris
   }
3543
3544 381:2dc8163e9150 Chris
   if ($LocalGlobalLocal eq 'local') {
3545
      if ($var{'usecontentsm'} eq 'yes') {
3546
         print WRITEFILE " | <a href=\"$contentsname{$PathContents}$dirnamesingle{$PathContents}$var{'exthtml'}\">Local contents</a>\n";
3547
      }
3548 389:0bc92382a86b chris
      if ($var{'frames'} eq 'yes') {
3549
         print WRITEFILE " | $var{'textjumpindexlocal'} ";
3550 382:baff1c482d98 Chris
         print WRITEFILE "<a href=\"$var{'filenameindexshortlocal'}$var{'filenameextensionframe'}$dirnamesingle{$PathContents}$var{'exthtml'}\">short</a> | ";
3551 389:0bc92382a86b chris
         print WRITEFILE "<a href=\"$var{'filenameindexlonglocal'}$var{'filenameextensionframe'}$dirnamesingle{$PathContents}$var{'exthtml'}\">long</a>\n";
3552
      } else {
3553
         print WRITEFILE " | $var{'textjumpindexlocal'} ";
3554
         print WRITEFILE "<a href=\"$var{'filenameindexshortlocal'}$var{'filenameextensionindex'}$dirnamesingle{$PathContents}$var{'exthtml'}\">short</a> | ";
3555
         print WRITEFILE "<a href=\"$var{'filenameindexlonglocal'}$var{'filenameextensionindex'}$dirnamesingle{$PathContents}$var{'exthtml'}\">long</a>\n";
3556
      }
3557 381:2dc8163e9150 Chris
   }
3558
   print WRITEFILE "</p>\n\n";
3559
   print WRITEFILE "$var{'codehr'}\n";
3560
}
3561
3562
3563
#========================================================================
3564
# Construct the contents.m files or update
3565
#========================================================================
3566
sub ConstructContentsmFile
3567
{
3568
   local($LocalActDir, @localnames) = @_;
3569
   local(*CFILE, $name,$newline);
3570
   local($contentsfile, $isincontentsonly);
3571
   local(@lines, @autoaddlines, @emptylines);
3572
   local($autoadd) = 'AutoAdd';
3573
   local($autoaddsection) = 0;
3574
   local($emptylineflag) = 0;
3575
   local(%nameincontents);
3576
3577
   # Build the contents file name
3578
   $contentsfile = $LocalActDir.$contentsname{$LocalActDir}.$suffix;
3579
3580
   if (-e $contentsfile) {
3581
      open(CFILE,"<$contentsfile") || die("Cannot open contents file $contentsfile: $!\n");
3582
      while (<CFILE>) {
3583
         # Search for the specified string pattern
3584
         @words = split;
3585
         if ((@words >= 3) && ($words[2] eq '-')) {
3586
            $isincontentsonly = 0;
3587
            foreach $name (@localnames) {
3588
               if ($name eq $words[1]) {    # old
3589
               # if ($mfilename{$name} eq $words[1]) {
3590
                  $isincontentsonly = 1;
3591
                  $nameincontents{$name} = 1;
3592
                  $newline = sprintf("%% %-13s - %s\n", $mfilename{$name}, $apropos{$name});
3593
                  push(@lines, $newline);
3594
               }
3595
            }
3596
            # issue a warning, if file is in contents, but not as file in the directory
3597
            if ($isincontentsonly == 0) {
3598
               print "\rConstructContents: Obsolete entry  $words[1]  in  $contentsfile ! Entry not used.\n";
3599
            }
3600
         } else {
3601
            # look for the AutoAdd section, should be the second word
3602
            if ((@words >= 2) && ($words[1] eq $autoadd)) { $autoaddsection = 1; }
3603
            # push the red line in an array
3604
            push(@lines, $_);
3605
         }
3606
      }
3607
      close(CFILE);
3608
   } else {
3609
      $newline = "% MATLAB Files in directory  $LocalActDir\n%\n";
3610
      push(@lines, $newline);
3611
3612
   }
3613
3614
   # collect the file names, that were not included in original C|contents.m
3615
   foreach $name (@localnames) {
3616
      if (! defined $nameincontents{$name}) {
3617
         if (! ($mfilename{$name} =~ /contents/i)) {
3618
            $newline = sprintf("%% %-13s - %s\n", $mfilename{$name}, $apropos{$name});
3619
            push(@autoaddlines, $newline);
3620
         }
3621
      }
3622
   }
3623
3624
   # write/update C|contents.m only if variable is set
3625
   if ($var{'writecontentsm'} eq 'yes') {
3626
      unlink($contentsfile);
3627
      open(CFILE,">$contentsfile") || die("Cannot open contents file $contentsfile: $!\n");
3628
      # write old C|contents.m or header of new file, as long as comment lines
3629
      foreach $line (@lines) {
3630
         if ($emptylineflag == 0) {
3631
            if ($line =~ /^\s*%/) { print CFILE $line; }
3632
            else { $emptylineflag = 1; push(@emptylines, $line); }
3633
         } else { push(@emptylines, $line); }
3634
      }
3635
      # add header of AutoAdd section
3636
      if (($autoaddsection == 0) && (@autoaddlines > 0)) { print CFILE "%\n% $autoadd\n"; }
3637
      # add autoadd section lines (previously undocumented files
3638
      foreach $line (@autoaddlines) { print CFILE $line; }
3639
      # add tail of original C|contents.m (everything behind first non-comment line)
3640
      foreach $line (@emptylines)   { print CFILE $line; }
3641
      print CFILE "\n";
3642
      close CFILE;
3643
      if ($opt_silent) { print "\r"; }
3644
      print "   Contents file created/updated: $contentsfile\t";
3645
      if (!$opt_silent) { print "\n"; }
3646
   }
3647
}
3648
3649
3650
#========================================================================
3651
# Replace found special characters with their HTMl Entities
3652
#========================================================================
3653
sub SubstituteHTMLEntities {
3654
   local($_) = @_;
3655
3656
   # Replace & <-> &amp;  < <-> &lt;  > <-> &gt;  " <-> &quot;
3657
   s/&/&amp;/g; s/\</&lt;/g; s/\>/&gt;/g; s/\"/&quot;/g;
3658
   return $_;
3659
}
3660
3661
#========================================================================
3662
# Replace found m-filenamestring with full link.
3663
#========================================================================
3664
sub SubstituteName2Link {
3665
   local($_, $funname) = @_;
3666
   local($refstr1, $refstr2, $reffound);
3667
3668
   # Look for something matching in the line
3669
   if ( /(\W+)($funname)(\W+)/i ) {
3670
      $reffound = $2;
3671 388:dad587ecb8d0 chris
      $refstr1 = "<a class=\"mfun\" href=\"$hfileindexpath{$name}$hfilerelpath{$funname}$mfilename{$funname}$var{'exthtml'}\">";
3672 381:2dc8163e9150 Chris
      $refstr2 = "<\/a>";
3673
      # Do links only for exact case match
3674
      if ( ($var{'links2filescase'}  eq 'exact') || ($var{'links2filescase'}  eq 'exactvery') ) {
3675
         if ( /(\W+)($funname)(\W+)/g ) {
3676
            s/(\W+)($funname)(\W+)/$1$refstr1$funname$refstr2$3/g;
3677
         }
3678
         else {
3679
            # Print info for not matching case in references, good for check up of files
3680
            if ( ($var{'links2filescase'}  eq 'exactvery') ) {
3681
               print "Diff in case found: $funname  (case of file name)   <->  $reffound  (case in source code)\n";
3682
               print "     (source line)  $_ \n";
3683
            }
3684
         }
3685
      }
3686
      # Do links for exact match and additionally for all upper case (often used in original matlab help text)
3687
      elsif ( ($var{'links2filescase'}  eq 'exactupper') ) {
3688
         s/(\W+)($funname)(\W+)/$1$refstr1$2$refstr2$3/g;
3689
         $funname2 = "\U$funname\E";
3690
         s/(\W+)($funname2)(\W+)/$1$refstr1$2$refstr2$3/g;
3691
      }
3692
      # Do links for all case mixes, this calls for trouble under LINUX/UNIX
3693
      else {  #elsif ( ($var{'links2filescase'}  eq 'all') )
3694
         s/(\W+)($funname)(\W+)/$1$refstr1$2$refstr2$3/ig;
3695
      }
3696
   }
3697
3698
   return $_;
3699
}
3700
3701
#========================================================================
3702
# Construct the html files for each matlab file.
3703
#    Need to reread each matlab file to find the help text.
3704
#    Note that we can't do this in a single loop because sometimes
3705
#    the help text maybe before the function declaration.
3706
#========================================================================
3707
sub ConstructHTMLFiles
3708
{
3709
   local(*MFILE);
3710
   local(*HFILE);
3711
3712
   local($filescreated) = 0;
3713
   local($functionline);
3714
3715
   foreach $name (@names) {
3716
      # Create cross reference information already here, used for keywords as well
3717
      # Construct list of referenced functions
3718
      @xref = @{'depcalls'.$name};    # the functions, that this m-file calls
3719
      @yref = @{'depcalled'.$name};   # the functions, that this m-file is called from
3720
      # print "   depcalls: @{'depcalls'.$name}\n   depcalled: @{'depcalled'.$name}\n";
3721
      # foreach $cname (@names) { next if $cname eq $name; push(@yref,$cname) if grep(/$name/,@{'depcalls'.$cname}); }
3722
3723
3724
      # Open m-file and html-file
3725
      open(MFILE,"<$mfile{$name}");
3726
      open(HFILE,">$hfile{$name}");
3727
3728
      # Write the header of HTML file
3729
      print HFILE "$TextDocTypeHTML\n<html>\n<head>\n$var{'codeheadmeta'}\n$TextMetaCharset\n$var{'csslink'}\n";
3730
3731
      # Write meta tags: use apropos (one line function description) for description
3732
      # and cross reference function names for keywords (any better ideas?)
3733
      print HFILE "<meta name=\"description\" content=\" $apropos{$name} \" />\n";
3734
      print HFILE "<meta name=\"keywords\" content=\" @xref @yref \" />\n";
3735
3736
      # Write Title and start body of html-file
3737
      print HFILE "<title>$var{'texttitlefiles'} $mfilename{$name}</title>\n</head>\n";
3738
      print HFILE "<body $var{'codebodyfiles'}>\n";
3739 410:675de8e6becf chris
      print HFILE "<div id=\"matlabdoc\">\n";
3740 381:2dc8163e9150 Chris
      print HFILE "<h1 $var{'codeheader'}>$var{'textheaderfiles'} $mfilename{$name}</h1>\n";
3741 401:a0f6e994657f chris
3742
# http://test.soundsoftware.ac.uk/cannam/projects/smallbox/repository/annotate/DL/RLS-DLA/SolveFISTA.m
3743 410:675de8e6becf chris
#      print HFILE "<a href=\"" . $hfileindexpath{$name} . "../../projects/smallbox/repository/annotate/" . $mfiledir{$name}  . $mfilename{$name} . ".m\">View in repository</a>\n";
3744 401:a0f6e994657f chris
3745 381:2dc8163e9150 Chris
      print HFILE "$var{'codehr'}\n";
3746
3747
      # include links to short/long - local/global index and C|contents.m
3748
      &ConstructLinks2Index(HFILE, $hfileindexpath{$name}, $mfiledir{$name}, 'local');
3749
3750
      # If this is a function, then write out the first line as a synopsis
3751
      if ($mtype{$name} eq "function") {
3752
         print HFILE "<h2 $var{'codeheader'}>Function Synopsis</h2>\n";
3753
         print HFILE "<pre>$synopsis{$name}</pre>\n$var{'codehr'}\n";
3754
      }
3755
3756
      # Look for the matlab help text block
3757
      $functionline = "\n";
3758
      do {
3759
         $_ = <MFILE>;
3760
         # remember functionline, if before help text block
3761
         if (/^\s*function/) { $functionline = $_; }
3762
      } until (/^\s*%/ || eof);
3763
      if (! (eof(MFILE))) {
3764
         print HFILE "<h2 $var{'codeheader'}>Help text</h2>\n";
3765
         print HFILE "<pre>\n";
3766
         while (/^\s*%/) {
3767
            # First remove leading % and white space, then Substitute special characlers
3768
            s/^\s*%//;
3769
            $_ = &SubstituteHTMLEntities($_);
3770
3771
            # check/create cross references
3772
            foreach $funname (@{'all'.$name}) {
3773
               if ($funname =~ /simulink/) { print "\n Simulink - Filename: $name;  scanname: $funname\n"; }
3774
               next if $funname eq $name;
3775
               $_ = &SubstituteName2Link($_, $funname);
3776
            }
3777
            print HFILE $_;
3778
            if (! eof) { $_ = <MFILE>; }
3779
         }
3780
         print HFILE "</pre>\n$var{'codehr'}\n";
3781
      }
3782
3783
      # Write the cross reference information
3784
      if (@xref || @yref) {
3785
         print HFILE "<h2 $var{'codeheader'}>Cross-Reference Information</H2>\n";
3786
         print HFILE "<table border=\"0\" width=\"100%\">\n<tr align=\"left\">\n<th width=\"50%\">";
3787
         if (@xref) {
3788
            print HFILE "This $mtype{$name} calls";
3789
         }
3790
         print HFILE "</th>\n<th width=\"50%\">";
3791
         if (@yref) {
3792
            print HFILE "This $mtype{$name} is called by";
3793
         }
3794
         print HFILE "</th>\n</tr>\n<tr valign=\"top\"><td>";
3795
         if (@xref) {
3796
            print HFILE "\n<ul>\n";
3797
            foreach $cname (sort @xref) {
3798
               print HFILE "<li><a class=\"mfun\" href=\"$hfileindexpath{$name}$hfilerelpath{$cname}$mfilename{$cname}$var{'exthtml'}\">$mfilename{$cname}</a></li>\n";
3799
            }
3800
            print HFILE "</ul>\n";
3801
         }
3802
         print HFILE "</td><td>";
3803
         if (@yref) {
3804
            print HFILE "\n<ul>\n";
3805
            foreach $cname (sort @yref) {
3806
               print HFILE "<li><a class=\"mfun\" href=\"$hfileindexpath{$name}$hfilerelpath{$cname}$mfilename{$cname}$var{'exthtml'}\">$mfilename{$cname}</a></li>\n";
3807
            }
3808
            print HFILE "</ul>\n";
3809
         }
3810
         print HFILE "</td>\n</tr>\n</table>\n";
3811
         print HFILE "$var{'codehr'}\n";
3812
      }
3813
3814
      # Include source text if requested
3815
      if (($var{'includesource'} eq 'yes') && (! ($mfilename{$name} =~ /^contents$/i))) {
3816
         print HFILE "<h2 $var{'codeheader'}>Listing of $mtype{$name} $mfilename{$name}</h2>\n";
3817
         seek(MFILE,0,0);
3818
         print HFILE "<pre>\n";
3819
         $IsStillHelp = 2;
3820
         print HFILE $functionline;    # functionline from scanning of help
3821
         while (<MFILE>) {
3822
            if ($IsStillHelp == 2) {
3823
               next     if (/^\s*$/);
3824
               next     if (/^\s*function/);
3825
               if (/^\s*%/) { $IsStillHelp = 1; next; }
3826
            } elsif ($IsStillHelp == 1) {
3827
               next     if (/^\s*%/);
3828
               $IsStillHelp = 0;
3829
            }
3830
3831
            # Substritute special characters
3832
            $_ = &SubstituteHTMLEntities($_);
3833
3834
            # check for comment in line and format with css em
3835 400:4ad6499d7998 chris
            s/^(.*)%(.*?)([\s\r\n]+)$/$1<em class=\"mcom\">%$2<\/em>$3/;
3836 381:2dc8163e9150 Chris
3837
            # check/create cross references
3838
            foreach $funname (@{'all'.$name}) {
3839
               next if $funname eq $name;
3840
               $_ = &SubstituteName2Link($_, $funname);
3841
            }
3842
            print HFILE $_;
3843
         }
3844
         print HFILE "</pre>\n$var{'codehr'}\n";
3845
      }
3846
3847
      # Include info about author from authorfile
3848
      &WriteFile2Handle($var{'authorfile'}, HFILE)   ;
3849
3850
      print HFILE "<!--navigate-->\n";
3851
      print HFILE "<!--copyright-->\n";
3852 410:675de8e6becf chris
      print HFILE "</div>\n</body>\n</html>\n";
3853 381:2dc8163e9150 Chris
      close(MFILE);
3854
      close(HFILE);
3855
3856
      # Print name of finished file
3857
      if ($opt_silent) { print "\r"; }
3858
      print "   HTML-File created: $hfile{$name}\t";
3859
      if (!$opt_silent) { print "\n"; }
3860
      $filescreated++;
3861
   }
3862
3863
   print "\n$PROGRAM: $indexcreated index and $filescreated files created.\n";
3864
}
3865
3866
#========================================================================
3867
# Function:	CheckFileName
3868
# Purpose:	.
3869
#========================================================================
3870
sub CheckFileName {
3871
   local($filename, $description) = @_;
3872
   local(*CHECKFILE);
3873
3874
   open(CHECKFILE,"<$filename") || do {
3875
      if ($description eq '') {$description = 'file';}
3876
      # if (!$opt_silent) { print "Cannot open $description $filename: $!\n"; }
3877
      print "Cannot open $description $filename: $!\n";
3878
      return 1;
3879
   };
3880
   close(CHECKFILE);
3881
   return 0;
3882
3883
}
3884
3885
#========================================================================
3886
# Function:	CheckDirName
3887
# Purpose:	.
3888
#========================================================================
3889
sub CheckDirName {
3890
   local($dirname, $description) = @_;
3891
   local(*CHECKDIR);
3892
3893
   opendir(CHECKDIR,"$dirname") || die ("Cannot open $description directory $dirname: $!\n");
3894
   closedir(CHECKDIR);
3895
}
3896
3897
#========================================================================
3898
# Function:	WriteFile2Handle
3899
# Purpose:	.
3900
#========================================================================
3901
sub WriteFile2Handle {
3902
   local($filename, *WRITEFILE) = @_;
3903
   local(*READFILE);
3904
3905
   if ($filename ne '') {
3906
      open(READFILE,"<$filename");
3907
      @filecontents = <READFILE>;
3908
      close(READFILE);
3909
      print WRITEFILE "@filecontents\n";
3910
      # if (!$opt_silent) {print "      Contents of $filename added\n"};
3911
   }
3912
}
3913
3914
3915
#========================================================================
3916
# Function:	GetConfigFile
3917
# Purpose:	Read user's configuration file, if such exists.
3918
#========================================================================
3919
sub GetConfigFile
3920
{
3921
   local($filename) = @_;
3922
   local(*CONFIG);
3923
   local($value);
3924
3925
   if (&CheckFileName($filename, 'configuration file')) {
3926
      # if (!$opt_silent) { print "   Proceeding using built-in defaults for configuration.\n"; }
3927
      print "   Proceeding using built-in defaults for configuration.\n";
3928
      return 0;
3929
   };
3930
3931
   open(CONFIG,"< $filename");
3932
   while (<CONFIG>) {
3933
      s/#.*$//;
3934
      next if /^\s*$/o;
3935
3936
      # match keyword: process one or more arguments
3937
      # keyword set
3938
      if (/^\s*set\s+(\S+)\s*=\s*(.*)/) {
3939
         # setting a configuration variable
3940
         if (defined $var{$1}) {
3941
            $var{$1} = $2;
3942
            if ($debug > 3) { print "$1:   $var{$1}\n"; }
3943
         }
3944
         else {
3945
            print "$PROGRAM: unknown variable `$1' in configuration file\n"
3946
         }
3947
      } else {
3948
         chop($_);
3949
         print "$PROGRAM: unknown keyword in configuration file in line: `$_'\n"
3950
      }
3951
   }
3952
   close CONFIG;
3953
   1;
3954
}
3955
3956
3957
#------------------------------------------------------------------------
3958
# DisplayHelp - display help text using -h or -help command-line switch
3959
#------------------------------------------------------------------------
3960
sub DisplayHelp
3961
{
3962
   $help=<<EofHelp;
3963
   $PROGRAM v$VERSION - generate html documentation from Matlab m-files
3964
3965
   Usage: $PROGRAM [-h] [-c config_file] [-m|dirmfiles matlab_dir] [-d|dirhtml html_dir]
3966
                   [-i yes|no] [-r yes|no] [-p yes|no] [-quiet|q] [-a authorfile]
3967
3968
   $PROGRAM is a perl script that reads each matlab .m file in a directory
3969
   to produce a corresponding .html file of help documentation and cross
3970
   reference information. An index file is written with links to all of
3971
   the html files produced. The options are:
3972
3973
      -quiet         or -q : be silent, no status information during generation
3974
      -help          or -h : display this help message
3975
      -todo          or -t : print the todo list for $PROGRAM
3976
      -version       or -v : display version
3977
3978
      -configfile    or -c : name of configuration file (default to $var{'configfile'}).
3979
      -dirmfiles     or -m : top level directory containing matlab files to generate html for;
3980
                             default to actual directory.
3981
      -dirhtml       or -d : top level directory for generated html files;
3982
                             default to actual directory.
3983
3984
      -includesource or -i : Include matlab source in the html documentation [yes|no]
3985
                             default to yes.
3986
      -processtree   or -r : create docu for m-file directory and all subdirectories [yes|no];
3987
                             default to yes.
3988
      -producetree   or -p : create multi-level docu identical to directory structure
3989
                             of m-files [yes|no]; default to yes.
3990
      -writecontentsm or -w: update or write contents.m files into the matlab source
3991
                             directories [yes|no]; default to no.
3992
3993
      -authorfile    or -a : name of file including author information, last element in html;
3994
                             default to empty.
3995
3996
   The command line setting overwrite all other settings (built-in and configuration file).
3997
   The configuration file settings overwrite the built-in settings (and not the command
3998
   line settings).
3999
4000
   Typical usages are:
4001
     $PROGRAM
4002
        (use default parameters from perl script, if configuration
4003
         file is found -> generation of docu, else display of help)
4004
4005
     $PROGRAM -dirmfiles matlab -dirhtml html
4006
        (generate html documentation for all m-files in directory matlab,
4007
         place html files in directory html, use built-in defaults for
4008
         all other parameters, this way all m-files in the directory
4009
         matlab and below are converted and the generated html-files are
4010
         placed in the directory html and below producing the same
4011
         directory structure than below matlab)
4012
4013
     $PROGRAM -quiet
4014
        (use built-in parameters from perl script, if configuration
4015
         file is found use these settings as well, do generation,
4016
         no display except critical errors, status of conversion and result)
4017
4018
     $PROGRAM -m toolbox -dirhtml doc/html -r yes -p no
4019
        (convert all m-files in directory toolbox and below and place
4020
         the generated html files in directory doc/html, read all m-files
4021
         recursively, however, the generated html files are placed in one
4022
         directory)
4023
4024
     $PROGRAM -m toolbox -dirhtml doc/html -i no -r no
4025
        (convert all m-files in directory toolbox and place
4026
         the generated html files in directory doc/html, do not read m-files
4027
         recursively, do not include source code in documentation)
4028
4029
EofHelp
4030
4031
   die "$help";
4032
}
4033
4034
#------------------------------------------------------------------------
4035
# DisplayTodo - display ToDo list using -t or -todo command-line switch
4036
#------------------------------------------------------------------------
4037
sub DisplayTodo
4038
{
4039
   $todo=<<EofToDo;
4040
      $PROGRAM v$VERSION - ToDo list
4041
4042
       o	use more than one high level directory
4043
4044
       o	what should/could be done here???
4045
4046
EofToDo
4047
4048
   die "$todo";
4049
}
4050
4051
4052
#------------------------------------------------------------------------
4053
# ListVariables - list all defined variables and their values
4054
#------------------------------------------------------------------------
4055
sub ListVariables
4056
{
4057
   local($value);
4058
4059
   if ($debug > 0) {
4060
      print "List of all variables and their values\n";
4061
      foreach (sort keys %var)
4062
      {
4063
         if ($var{$_} eq '') {
4064
            $value = "empty";
4065
         } else {
4066
            $value = $var{$_};
4067
         }
4068
         print "   $_\n      $value\n";
4069
      }
4070
      print "\n\n";
4071
   }
4072
}
4073
4074
4075
__END__
4076
:endofperl
4077 0:513646585e45 Chris
#!/usr/bin/env ruby
4078
4079
# == Synopsis
4080
#
4081
# reposman: manages your repositories with Redmine
4082
#
4083
# == Usage
4084
#
4085
#    reposman [OPTIONS...] -s [DIR] -r [HOST]
4086 441:cbce1fd3b1b7 Chris
#
4087 0:513646585e45 Chris
#  Examples:
4088 241:7658d21a1493 chris
#    reposman --scm-dir=/var/svn --redmine-host=redmine.example.net --scm subversion
4089 0:513646585e45 Chris
#    reposman -s /var/git -r redmine.example.net -u http://svn.example.net --scm git
4090
#
4091
# == Arguments (mandatory)
4092
#
4093 241:7658d21a1493 chris
#   -s, --scm-dir=DIR         use DIR as base directory for repositories
4094 0:513646585e45 Chris
#   -r, --redmine-host=HOST   assume Redmine is hosted on HOST. Examples:
4095
#                             -r redmine.example.net
4096
#                             -r http://redmine.example.net
4097
#                             -r https://example.net/redmine
4098 909:cbb26bc654de Chris
#   -k, --key=KEY             use KEY as the Redmine API key (you can use the
4099
#                             --key-file option as an alternative)
4100 0:513646585e45 Chris
#
4101
# == Options
4102
#
4103
#   -o, --owner=OWNER         owner of the repository. using the rails login
4104
#                             allow user to browse the repository within
4105
#                             Redmine even for private project. If you want to
4106
#                             share repositories through Redmine.pm, you need
4107
#                             to use the apache owner.
4108
#   -g, --group=GROUP         group of the repository. (default: root)
4109
#   --scm=SCM                 the kind of SCM repository you want to create (and
4110
#                             register) in Redmine (default: Subversion).
4111
#                             reposman is able to create Git and Subversion
4112
#                             repositories. For all other kind, you must specify
4113
#                             a --command option
4114
#   -u, --url=URL             the base url Redmine will use to access your
4115
#                             repositories. This option is used to automatically
4116
#                             register the repositories in Redmine. The project
4117
#                             identifier will be appended to this url. Examples:
4118
#                             -u https://example.net/svn
4119
#                             -u file:///var/svn/
4120 28:12420e46bed9 chris
#                             if this option isn't set, reposman will register
4121
#                             the repositories with local file paths in Redmine
4122 0:513646585e45 Chris
#   -c, --command=COMMAND     use this command instead of "svnadmin create" to
4123
#                             create a repository. This option can be used to
4124
#                             create repositories other than subversion and git
4125
#                             kind.
4126
#                             This command override the default creation for git
4127
#                             and subversion.
4128 13:80433603a2cd Chris
#   --http-user=USER          User for HTTP Basic authentication with Redmine WS
4129
#   --http-pass=PASSWORD      Password for Basic authentication with Redmine WS
4130 909:cbb26bc654de Chris
#       --key-file=PATH       path to a file that contains the Redmine API key
4131
#                             (use this option instead of --key if you don't
4132
#                             the key to appear in the command line)
4133 0:513646585e45 Chris
#   -t, --test                only show what should be done
4134
#   -h, --help                show help and exit
4135
#   -v, --verbose             verbose
4136
#   -V, --version             print version and exit
4137
#   -q, --quiet               no log
4138
#
4139
# == References
4140 441:cbce1fd3b1b7 Chris
#
4141 0:513646585e45 Chris
# You can find more information on the redmine's wiki : http://www.redmine.org/wiki/redmine/HowTos
4142
4143
4144
require 'getoptlong'
4145 1332:1d1cb01c0417 Chris
#require 'rdoc/usage'
4146 0:513646585e45 Chris
require 'find'
4147
require 'etc'
4148
4149
Version = "1.3"
4150
SUPPORTED_SCM = %w( Subversion Darcs Mercurial Bazaar Git Filesystem )
4151
4152
opts = GetoptLong.new(
4153 241:7658d21a1493 chris
                      ['--scm-dir',      '-s', GetoptLong::REQUIRED_ARGUMENT],
4154 0:513646585e45 Chris
                      ['--redmine-host', '-r', GetoptLong::REQUIRED_ARGUMENT],
4155
                      ['--key',          '-k', GetoptLong::REQUIRED_ARGUMENT],
4156 909:cbb26bc654de Chris
                      ['--key-file',           GetoptLong::REQUIRED_ARGUMENT],
4157 0:513646585e45 Chris
                      ['--owner',        '-o', GetoptLong::REQUIRED_ARGUMENT],
4158
                      ['--group',        '-g', GetoptLong::REQUIRED_ARGUMENT],
4159
                      ['--url',          '-u', GetoptLong::REQUIRED_ARGUMENT],
4160
                      ['--command' ,     '-c', GetoptLong::REQUIRED_ARGUMENT],
4161
                      ['--scm',                GetoptLong::REQUIRED_ARGUMENT],
4162 13:80433603a2cd Chris
                      ['--http-user',          GetoptLong::REQUIRED_ARGUMENT],
4163
                      ['--http-pass',          GetoptLong::REQUIRED_ARGUMENT],
4164 0:513646585e45 Chris
                      ['--test',         '-t', GetoptLong::NO_ARGUMENT],
4165
                      ['--verbose',      '-v', GetoptLong::NO_ARGUMENT],
4166
                      ['--version',      '-V', GetoptLong::NO_ARGUMENT],
4167
                      ['--help'   ,      '-h', GetoptLong::NO_ARGUMENT],
4168
                      ['--quiet'  ,      '-q', GetoptLong::NO_ARGUMENT]
4169
                      )
4170
4171
$verbose      = 0
4172
$quiet        = false
4173
$redmine_host = ''
4174
$repos_base   = ''
4175 13:80433603a2cd Chris
$http_user    = ''
4176
$http_pass    = ''
4177 0:513646585e45 Chris
$svn_owner    = 'root'
4178
$svn_group    = 'root'
4179
$use_groupid  = true
4180
$svn_url      = false
4181
$test         = false
4182
$scm          = 'Subversion'
4183
4184
def log(text, options={})
4185
  level = options[:level] || 0
4186
  puts text unless $quiet or level > $verbose
4187
  exit 1 if options[:exit]
4188
end
4189
4190
def system_or_raise(command)
4191
  raise "\"#{command}\" failed" unless system command
4192
end
4193
4194 1332:1d1cb01c0417 Chris
def usage
4195
  puts "See source code for supported options"
4196
  exit
4197
end
4198
4199 0:513646585e45 Chris
module SCM
4200
4201
  module Subversion
4202
    def self.create(path)
4203
      system_or_raise "svnadmin create #{path}"
4204
    end
4205
  end
4206
4207
  module Git
4208
    def self.create(path)
4209
      Dir.mkdir path
4210
      Dir.chdir(path) do
4211
        system_or_raise "git --bare init --shared"
4212
        system_or_raise "git update-server-info"
4213
      end
4214
    end
4215
  end
4216
4217
end
4218
4219
begin
4220
  opts.each do |opt, arg|
4221
    case opt
4222 241:7658d21a1493 chris
    when '--scm-dir';        $repos_base   = arg.dup
4223 0:513646585e45 Chris
    when '--redmine-host';   $redmine_host = arg.dup
4224
    when '--key';            $api_key      = arg.dup
4225 909:cbb26bc654de Chris
    when '--key-file'
4226
      begin
4227
        $api_key = File.read(arg).strip
4228
      rescue Exception => e
4229
        $stderr.puts "Unable to read the key from #{arg}: #{e.message}"
4230
        exit 1
4231
      end
4232 0:513646585e45 Chris
    when '--owner';          $svn_owner    = arg.dup; $use_groupid = false;
4233
    when '--group';          $svn_group    = arg.dup; $use_groupid = false;
4234
    when '--url';            $svn_url      = arg.dup
4235
    when '--scm';            $scm          = arg.dup.capitalize; log("Invalid SCM: #{$scm}", :exit => true) unless SUPPORTED_SCM.include?($scm)
4236 13:80433603a2cd Chris
    when '--http-user';      $http_user    = arg.dup
4237
    when '--http-pass';      $http_pass    = arg.dup
4238 0:513646585e45 Chris
    when '--command';        $command =      arg.dup
4239
    when '--verbose';        $verbose += 1
4240
    when '--test';           $test = true
4241
    when '--version';        puts Version; exit
4242 1332:1d1cb01c0417 Chris
    when '--help';           usage
4243 0:513646585e45 Chris
    when '--quiet';          $quiet = true
4244
    end
4245
  end
4246
rescue
4247
  exit 1
4248
end
4249
4250
if $test
4251
  log("running in test mode")
4252
end
4253
4254
# Make sure command is overridden if SCM vendor is not handled internally (for the moment Subversion and Git)
4255
if $command.nil?
4256
  begin
4257
    scm_module = SCM.const_get($scm)
4258
  rescue
4259
    log("Please use --command option to specify how to create a #{$scm} repository.", :exit => true)
4260
  end
4261
end
4262
4263
$svn_url += "/" if $svn_url and not $svn_url.match(/\/$/)
4264
4265
if ($redmine_host.empty? or $repos_base.empty?)
4266 1332:1d1cb01c0417 Chris
  usage
4267 0:513646585e45 Chris
end
4268
4269
unless File.directory?($repos_base)
4270 217:ed8222a04634 chris
  log("directory '#{$repos_base}' doesn't exist", :exit => true)
4271 0:513646585e45 Chris
end
4272
4273
begin
4274
  require 'active_resource'
4275
rescue LoadError
4276
  log("This script requires activeresource.\nRun 'gem install activeresource' to install it.", :exit => true)
4277
end
4278
4279 37:94944d00e43c chris
class Project < ActiveResource::Base
4280 217:ed8222a04634 chris
  self.headers["User-agent"] = "SoundSoftware repository manager/#{Version}"
4281 909:cbb26bc654de Chris
  self.format = :xml
4282 37:94944d00e43c chris
end
4283 0:513646585e45 Chris
4284
log("querying Redmine for projects...", :level => 1);
4285
4286
$redmine_host.gsub!(/^/, "http://") unless $redmine_host.match("^https?://")
4287
$redmine_host.gsub!(/\/$/, '')
4288
4289
Project.site = "#{$redmine_host}/sys";
4290 13:80433603a2cd Chris
Project.user = $http_user;
4291
Project.password = $http_pass;
4292 0:513646585e45 Chris
4293
begin
4294
  # Get all active projects that have the Repository module enabled
4295
  projects = Project.find(:all, :params => {:key => $api_key})
4296 909:cbb26bc654de Chris
rescue ActiveResource::ForbiddenAccess
4297
  log("Request was denied by your Redmine server. Make sure that 'WS for repository management' is enabled in application settings and that you provided the correct API key.")
4298 0:513646585e45 Chris
rescue => e
4299
  log("Unable to connect to #{Project.site}: #{e}", :exit => true)
4300
end
4301
4302
if projects.nil?
4303 909:cbb26bc654de Chris
  log('No project found, perhaps you forgot to "Enable WS for repository management"', :exit => true)
4304 0:513646585e45 Chris
end
4305
4306 1107:4f45ab104990 Chris
log("found #{projects.size} projects at " + Time.now.inspect);
4307 0:513646585e45 Chris
4308
def set_owner_and_rights(project, repos_path, &block)
4309 441:cbce1fd3b1b7 Chris
  if mswin?
4310 0:513646585e45 Chris
    yield if block_given?
4311
  else
4312
    uid, gid = Etc.getpwnam($svn_owner).uid, ($use_groupid ? Etc.getgrnam(project.identifier).gid : Etc.getgrnam($svn_group).gid)
4313 34:09b1d4349da3 Chris
    right = project.is_public ? 02775 : 02770
4314 0:513646585e45 Chris
    yield if block_given?
4315
    Find.find(repos_path) do |f|
4316
      File.chmod right, f
4317
      File.chown uid, gid, f
4318
    end
4319
  end
4320
end
4321
4322
def other_read_right?(file)
4323
  (File.stat(file).mode & 0007).zero? ? false : true
4324
end
4325
4326
def owner_name(file)
4327
  mswin? ?
4328
    $svn_owner :
4329 441:cbce1fd3b1b7 Chris
    Etc.getpwuid( File.stat(file).uid ).name
4330 0:513646585e45 Chris
end
4331 441:cbce1fd3b1b7 Chris
4332 0:513646585e45 Chris
def mswin?
4333
  (RUBY_PLATFORM =~ /(:?mswin|mingw)/) || (RUBY_PLATFORM == 'java' && (ENV['OS'] || ENV['os']) =~ /windows/i)
4334
end
4335
4336
projects.each do |project|
4337 1107:4f45ab104990 Chris
  log("inspecting project #{project.name}", :level => 1)
4338 0:513646585e45 Chris
4339
  if project.identifier.empty?
4340 1107:4f45ab104990 Chris
    log("\tno identifier for project #{project.name}!")
4341 0:513646585e45 Chris
    next
4342 1445:0c7b3bb73517 Chris
  elsif not project.identifier.match(/^[a-z0-9_\-]+$/)
4343 1107:4f45ab104990 Chris
    log("\tinvalid identifier for project #{project.name} : #{project.identifier}!");
4344 0:513646585e45 Chris
    next;
4345
  end
4346
4347
  repos_path = File.join($repos_base, project.identifier).gsub(File::SEPARATOR, File::ALT_SEPARATOR || File::SEPARATOR)
4348
4349 28:12420e46bed9 chris
  create_repos = false
4350
  # Logic required for SoundSoftware.ac.uk repositories:
4351
  #
4352
  # * If the project has a repository path declared already,
4353
  #   - if it's a local path,
4354
  #     - if it does not exist
4355
  #       - if it has the right root
4356
  #         - create it
4357
  #   - else
4358
  #     - leave alone (remote repository)
4359
  # * else
4360
  #   - create repository with same name as project
4361
  #   - set to project
4362
4363
  if project.respond_to?(:repository)
4364
4365
    repos_url = project.repository.url;
4366 1107:4f45ab104990 Chris
    log("\texisting url for project #{project.identifier} is #{repos_url}", :level => 2);
4367 28:12420e46bed9 chris
4368
    if repos_url.match(/^file:\//) || repos_url.match(/^\//)
4369
4370
      repos_url = repos_url.gsub(/^file:\/*/, "/");
4371 1107:4f45ab104990 Chris
      log("\tthis is a local file path, at #{repos_url}", :level => 2);
4372 28:12420e46bed9 chris
4373
      if repos_url.slice(0, $repos_base.length) != $repos_base
4374
        # leave repos_path set to our original suggestion
4375 1107:4f45ab104990 Chris
        log("\tpreparing to replace incorrect repo location #{repos_url} for #{project.name} with #{repos_path}");
4376 28:12420e46bed9 chris
        create_repos = true
4377
      else
4378
        if !File.directory?(repos_url)
4379 1107:4f45ab104990 Chris
          log("\tpreparing to create repo for #{project.name} at #{repos_url}");
4380 28:12420e46bed9 chris
          repos_path = repos_url
4381
          create_repos = true
4382
        else
4383 1107:4f45ab104990 Chris
          log("\tit exists and is in the right place", :level => 2);
4384 28:12420e46bed9 chris
        end
4385
      end
4386
    else
4387 1107:4f45ab104990 Chris
      log("\tthis is a remote path, leaving alone", :level => 2);
4388 28:12420e46bed9 chris
    end
4389
  else
4390 1107:4f45ab104990 Chris
    log("\tpreparing to set repo location and create for #{project.name} at #{repos_url}")
4391 28:12420e46bed9 chris
#    if File.directory?(repos_path)
4392
#      log("\trepository path #{repos_path} already exists, not creating")
4393
#    else
4394
      create_repos = true
4395
#    end
4396
  end
4397
4398
  if create_repos
4399
4400
    registration_url = repos_path
4401
    if $svn_url
4402
      registration_url = "#{$svn_url}#{project.identifier}"
4403
    end
4404 0:513646585e45 Chris
4405
    if $test
4406 28:12420e46bed9 chris
      log("\tproposal: create repository #{repos_path}")
4407
      log("\tproposal: register repository #{repos_path} in Redmine with vendor #{$scm}, url #{registration_url}")
4408 0:513646585e45 Chris
      next
4409
    end
4410
4411 52:8c3409528d3a Chris
# No -- we need "other" users to be able to read it.  Access control
4412
# is not handled through Unix user id anyway
4413
#    project.is_public ? File.umask(0002) : File.umask(0007)
4414
    File.umask(0002)
4415
4416 28:12420e46bed9 chris
    log("\taction: create repository #{repos_path}")
4417 0:513646585e45 Chris
4418
    begin
4419 28:12420e46bed9 chris
      if !File.directory?(repos_path)
4420
        set_owner_and_rights(project, repos_path) do
4421
          if scm_module.nil?
4422
            log("\trunning command: #{$command} #{repos_path}")
4423
            system_or_raise "#{$command} #{repos_path}"
4424
          else
4425
            scm_module.create(repos_path)
4426
          end
4427 0:513646585e45 Chris
        end
4428
      end
4429
    rescue => e
4430
      log("\tunable to create #{repos_path} : #{e}\n")
4431
      next
4432
    end
4433
4434 28:12420e46bed9 chris
    begin
4435
      log("\taction: register repository #{repos_path} in Redmine with vendor #{$scm}, url #{registration_url}");
4436
      project.post(:repository, :vendor => $scm, :repository => {:url => "#{registration_url}"}, :key => $api_key)
4437
    rescue => e
4438
      log("\trepository #{repos_path} not registered in Redmine: #{e.message}");
4439 0:513646585e45 Chris
    end
4440
    log("\trepository #{repos_path} created");
4441
  end
4442 37:94944d00e43c chris
end
4443 0:513646585e45 Chris
4444 1107:4f45ab104990 Chris
log("project review completed at " + Time.now.inspect);
4445
4446 241:7658d21a1493 chris
#!/bin/sh
4447
4448 242:bde4f47b6427 chris
mirrordir="/var/mirror"
4449 1336:b61a51fb42b9 Chris
hg="/usr/bin/hg"
4450 242:bde4f47b6427 chris
4451 241:7658d21a1493 chris
project="$1"
4452
local_repo="$2"
4453
remote_repo="$3"
4454
4455
if [ -z "$project" ] || [ -z "$local_repo" ] || [ -z "$remote_repo" ]; then
4456
    echo "Usage: $0 <project> <local-repo-path> <remote-repo-url>"
4457
    exit 2
4458
fi
4459
4460
  # We need to handle different source repository types separately.
4461
  #
4462
  # The convert extension cannot convert directly from a remote git
4463
  # repo; we'd have to mirror to a local repo first.  Incremental
4464
  # conversions do work though.  The hg-git plugin will convert
4465
  # directly from remote repositories, but not via all schemes
4466
  # (e.g. https is not currently supported).  It's probably easier to
4467
  # use git itself to clone locally and then convert or hg-git from
4468
  # there.
4469
  #
4470
  # We can of course convert directly from remote Subversion repos,
4471
  # but we need to keep track of that -- you can ask to convert into a
4472
  # repo that has already been used (for Mercurial) and it'll do so
4473
  # happily; we don't want that.
4474
  #
4475
  # Converting from a remote Hg repo should be fine!
4476
  #
4477
  # One other thing -- we can't actually tell the difference between
4478
  # the various SCM types based on URL alone.  We have to try them
4479
  # (ideally in an order determined by a guess based on the URL) and
4480
  # see what happens.
4481
4482 242:bde4f47b6427 chris
project_mirror="$mirrordir/$project"
4483
mkdir -p "$project_mirror"
4484
project_repo_mirror="$project_mirror/repo"
4485 241:7658d21a1493 chris
4486 242:bde4f47b6427 chris
  # Some test URLs:
4487
  #
4488
  # http://aimc.googlecode.com/svn/trunk/
4489
  # http://aimc.googlecode.com/svn/
4490
  # http://vagar.org/git/flam
4491
  # https://github.com/wslihgt/IMMF0salience.git
4492
  # http://hg.breakfastquay.com/dssi-vst/
4493
  # git://github.com/schacon/hg-git.git
4494
  # http://svn.drobilla.net/lad (externals!)
4495
4496
# If we are importing from another distributed system, then our aim is
4497
# to create either a Hg repo or a git repo at $project_mirror, which
4498
# we can then pull from directly to the Hg repo at $local_repo (using
4499
# hg-git, in the case of a git repo).
4500
4501
# Importing from SVN, we should use hg convert directly to the target
4502
# hg repo (or should we?) but keep a record of the last changeset ID
4503
# we brought in, and test each time whether it matches the last
4504
# changeset ID actually in the repo
4505
4506
success=""
4507
4508 436:4eb486dbf730 Chris
# If we have a record of the last successfully updated remote repo
4509
# URL, check it against our current remote URL: if it has changed, we
4510
# will need to start again with a new clone rather than pulling
4511
# updates into the existing local mirror
4512
4513
successfile="$project_mirror/last_successful_url"
4514
if [ -f "$successfile" ]; then
4515
    last=$(cat "$successfile")
4516 437:102056ec2de9 chris
    if [ x"$last" = x"$remote_repo" ]; then
4517 436:4eb486dbf730 Chris
	echo "$$: Remote URL is unchanged from last successful update"
4518
    else
4519
	echo "$$: Remote URL has changed since last successful update:"
4520
	echo "$$: Last URL was $last, current is $remote_repo"
4521
	suffix="$$.$(date +%s)"
4522
	echo "$$: Moving existing repos to $suffix suffix and starting afresh"
4523
	mv "$project_repo_mirror" "$project_repo_mirror"."$suffix"
4524
	mv "$local_repo" "$local_repo"."$suffix"
4525
	mv "$successfile" "$successfile"."$suffix"
4526 437:102056ec2de9 chris
	touch "$project_mirror/url_changed"
4527 436:4eb486dbf730 Chris
    fi
4528
fi
4529
4530 242:bde4f47b6427 chris
if [ -d "$project_repo_mirror" ]; then
4531
4532
    # Repo mirror exists: update it
4533
    echo "$$: Mirror for project $project exists at $project_repo_mirror, updating" 1>&2
4534
4535
    if [ -d "$project_repo_mirror/.hg" ]; then
4536 433:7fd72f22a42b Chris
	"$hg" --config extensions.convert= convert --datesort "$remote_repo" "$project_repo_mirror" && success=true
4537 439:d3faf348b287 chris
	if [ -z "$success" ]; then
4538
	    ( cd "$project_repo_mirror" && "$hg" pull "$remote_repo" ) && success=true
4539
	fi
4540 242:bde4f47b6427 chris
    elif [ -d "$project_repo_mirror/.git" ]; then
4541 431:d3af621ba9d4 Chris
	( cd "$project_repo_mirror" && git pull "$remote_repo" master ) && success=true
4542 242:bde4f47b6427 chris
    else
4543
	echo "$$: ERROR: Repo mirror dir $project_repo_mirror exists but is not an Hg or git repo" 1>&2
4544
    fi
4545
4546
else
4547
4548
    # Repo mirror does not exist yet
4549
    echo "$$: Mirror for project $project does not yet exist at $project_repo_mirror, trying to convert or clone" 1>&2
4550
4551
    case "$remote_repo" in
4552
	*git*)
4553
	    git clone "$remote_repo" "$project_repo_mirror" ||
4554 433:7fd72f22a42b Chris
	    "$hg" --config extensions.convert= convert --datesort "$remote_repo" "$project_repo_mirror"
4555 242:bde4f47b6427 chris
	    ;;
4556
	*)
4557 433:7fd72f22a42b Chris
	    "$hg" --config extensions.convert= convert --datesort "$remote_repo" "$project_repo_mirror" ||
4558 299:defe55be97b9 chris
	    git clone "$remote_repo" "$project_repo_mirror" ||
4559 433:7fd72f22a42b Chris
	    "$hg" clone "$remote_repo" "$project_repo_mirror"
4560 242:bde4f47b6427 chris
	    ;;
4561
    esac && success=true
4562
4563
fi
4564
4565
echo "Success=$success"
4566
4567
if [ -n "$success" ]; then
4568
    echo "$$: Update successful, pulling into local repo at $local_repo"
4569 436:4eb486dbf730 Chris
    if [ ! -d "$local_repo" ]; then
4570
	"$hg" init "$local_repo"
4571
    fi
4572 242:bde4f47b6427 chris
    if [ -d "$project_repo_mirror/.git" ]; then
4573 436:4eb486dbf730 Chris
	( cd "$local_repo" && "$hg" --config extensions.hggit= pull "$project_repo_mirror" ) && echo "$remote_repo" > "$successfile"
4574 242:bde4f47b6427 chris
    else
4575 436:4eb486dbf730 Chris
	( cd "$local_repo" && "$hg" pull "$project_repo_mirror" ) && echo "$remote_repo" > "$successfile"
4576 242:bde4f47b6427 chris
    fi
4577
fi