1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
# include.pl - Include file for all the perl scripts that contains reusable functions
#
##############################
# Global Variables
##############################
$dummy_user = 'scm-gforge'; # unix name of the dummy user
$dummy_uid = getpwnam($dummy_user); # uid of the dummy user that will own group's files
$date = int(time()/3600/24); # Get the number of days since 1/1/1970 for /etc/shadow
@possible_paths = (
'/usr/share/gforge/bin',
'/usr/share/fusionforge/bin',
'/usr/local/share/gforge/bin',
'/usr/local/share/fusionforge/bin',
'/opt/gforge/bin',
'/opt/fusionforge/bin',
'/usr/bin',
'/usr/local/bin') ;
foreach $p (@possible_paths) {
if (-x "$p/forge_get_config") {
$fgc = "$p/forge_get_config";
last;
}
}
%forge_config_cache = ();
sub forge_get_config ($$) {
my $var = shift;
my $sec = shift || 'core';
if (!defined $forge_config_cache{$sec}{$var}) {
$forge_config_cache{$sec}{$var} = qx!$fgc $var $sec!;
chomp $forge_config_cache{$sec}{$var};
}
return $forge_config_cache{$sec}{$var};
}
$sys_default_domain = &forge_get_config ('web_host') ;
$sys_return_domain = &forge_get_config ('forum_return_domain') ;
$sys_scm_host = &forge_get_config ('web_host') ;
$domain_name = &forge_get_config ('web_host') ;
$sys_users_host = &forge_get_config ('users_host') ;
$sys_lists_host = &forge_get_config ('lists_host') ;
$sys_name = &forge_get_config ('forge_name') ;
$sys_themeroot = &forge_get_config ('themes_root') ;
$sys_news_group = &forge_get_config ('news_group') ;
$sys_dbhost = &forge_get_config ('database_host') ;
$sys_dbport = &forge_get_config ('database_port') ;
$sys_dbname = &forge_get_config ('database_name') ;
$sys_dbuser = &forge_get_config ('database_user') ;
$sys_dbpasswd = &forge_get_config ('database_password') ;
$sys_ldap_base_dn = &forge_get_config ('ldap_base_dn') ;
$sys_ldap_host = &forge_get_config ('ldap_host') ;
$server_admin = &forge_get_config ('admin_email') ;
$chroot_prefix = &forge_get_config ('chroot') ;
$homedir_prefix = &forge_get_config ('homedir_prefix') ;
$grpdir_prefix = &forge_get_config ('groupdir_prefix') ;
$file_dir = &forge_get_config ('data_path') ;
$sys_use_ssl = &forge_get_config('use_ssl');
$sys_urlprefix = &forge_get_config('url_prefix');
##############################
# Database Connect Functions
##############################
sub db_connect ( ) {
my $str = "DBI:Pg:dbname=$sys_dbname" ;
if ($sys_dbhost ne '') {
$str .= ";host=$sys_dbhost" ;
}
if ($sys_dbport ne '') {
$str .= ";port=$sys_dbport" ;
}
$dbh ||= DBI->connect($str,"$sys_dbuser","$sys_dbpasswd") ;
if (! $dbh) {
die "Error while connecting to database: $!" ;
}
}
sub db_disconnect ( ) {
$dbh->disconnect ;
$dbh = "" ;
}
sub db_drop_table_if_exists {
my ($sql, $res, $n, $tn) ;
$tn = shift ;
$sql = "SELECT COUNT(*) FROM pg_class WHERE relname='$tn'";
$res = $dbh->prepare($sql);
$res->execute();
($n) = $res->fetchrow() ;
$res->finish () ;
if ($n != 0) {
$sql = "DROP TABLE $tn";
$res = $dbh->prepare($sql);
$res->execute () ;
$res->finish () ;
}
}
##############################
# File open function, spews the entire file to an array.
##############################
sub open_array_file {
my $filename = shift(@_);
open (FD, $filename) || die "Can't open $filename: $!.\n";
@tmp_array = <FD>;
close(FD);
return @tmp_array;
}
#############################
# File write function.
#############################
sub write_array_file {
my ($file_name, @file_array) = @_;
my $oldmask = umask(077);
use File::Temp qw(tempfile);
use File::Basename qw(dirname);
my ($fd, $filename) ;
eval { ($fd, $filename) = tempfile( DIR => dirname($file_name), UNLINK => 0) } ;
umask($oldmask);
return 1 unless ($fd && $filename) ;
foreach (@file_array) {
if ($_ ne '') {
print $fd $_;
}
}
close($fd);
unless (rename ($filename, $file_name)) {
unlink $filename;
return 1;
}
return 0;
}
#######################
# Display a backtrace #
#######################
sub
debug_print_backtrace
{
my $i = 1;
print "Call Trace:\n";
while ((my @call_details = (caller($i++)))) {
print " + " . $call_details[1] . ":" . $call_details[2] .
" in function " . $call_details[3] . "\n";
}
}
#############################
# Compatibility functions.
#############################
sub util_make_url {
my ($path) = @_;
my $url;
if (($sys_use_ssl eq 'true') || ($sys_use_ssl eq '1')) {
$url = 'https://';
} else {
$url = 'http://';
}
$url .= $sys_default_domain . $sys_urlprefix;
$url =~ s,/$,,;
$path =~ s,^/,,;
$url .= '/' . $path;
return $url;
}
|
