← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to demo/netware/nutconnection.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
demo/netware/nutconnection.pp
 
1
unit nutconnection;
 
2
{
 
3
    This file is part of nutmon for netware
 
4
    Copyright (c) 2004 armin diehl (armin@freepascal.org)
 
5
 
 
6
    Simple class to connect to the nut upsd, see
 
7
    http://www.networkupstools.org for details about the
 
8
    protocol
 
9
 
 
10
    Tested with nut 2.0.1pre4
 
11
 
 
12
    This program is distributed in the hope that it will be useful,
 
13
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
14
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
15
 
 
16
 **********************************************************************}
 
17
{$mode objfpc}
 
18
 
 
19
interface
 
20
 
 
21
uses sysutils, ssockets;
 
22
 
 
23
Const
 
24
  NutDefaultPort = 3493;
 
25
  NutLineEnd    = #10;
 
26
  NutDataStale = 'ERR DATA-STALE';
 
27
 
 
28
type
 
29
  TNutException = class (Exception);
 
30
  TUpsStat   = (UPS_disconnected,UPS_stale,UPS_online,UPS_onBatt,UPS_lowBatt,UPS_FSD);
 
31
  TUpsStatus = set of TUpsStat;
 
32
  TNutConnection = class (TObject)
 
33
    private
 
34
     fSock : TInetSocket;
 
35
     fHost : string;
 
36
     fPort : word;
 
37
     fUpsName,fUserName,fPassword : string;
 
38
     fLogin : boolean;
 
39
     fDebug : boolean;
 
40
     fLastResponse : string;
 
41
 
 
42
      function isConnected : boolean;
 
43
      procedure doConnect (c : boolean);
 
44
      procedure setHost (s : string);
 
45
      procedure setPort (w : word);
 
46
      procedure sendCommand (s : string);
 
47
      function getOneLine : string;
 
48
      function getVersion : string;
 
49
      procedure setUpsName (s : string);
 
50
      procedure checkConnected;
 
51
      function getValue (name : string) : string;
 
52
      function getUpsLoad : string;
 
53
      function getUpsMfr : string;
 
54
      function getUpsModel : string;
 
55
      function getUpsRuntime : string;
 
56
      function getUpsCharge : string;
 
57
      function getUpsChargeInt : integer;
 
58
      function getUpsTemperature : string;
 
59
      function getInputFrequency : string;
 
60
      function getInputVoltage : string;
 
61
      function getOutputVoltage : string;
 
62
      function getUpsStatus : TUpsStatus;
 
63
      procedure setUserName (user : string);
 
64
      procedure setPassword (pwd : string);
 
65
      procedure doLogin (login : boolean);
 
66
      function getNumLogins : string;
 
67
    public
 
68
      property connected : boolean read isConnected write doConnect;
 
69
      property host : string read fHost write setHost;
 
70
      property port : word read fPort write setPort;
 
71
      property version : string read getVersion;
 
72
      property upsName : string read fUpsName write setUpsName;
 
73
      property upsload : string read getUpsLoad;
 
74
      property upsMfr : string read getUpsMfr;
 
75
      property upsModel : string read getUpsModel;
 
76
      property upsRuntime : string read getUpsRuntime;
 
77
      property upsCharge : string read getUpsCharge;
 
78
      property upsChargeInt : integer read getUpsChargeInt;
 
79
      property upsTemperature : string read getUpsTemperature;
 
80
      property upsInputFrequency : string read getInputFrequency;
 
81
      property upsInputVoltage : string read getInputVoltage;
 
82
      property upsOutputVoltage : string read getOutputVoltage;
 
83
      property upsStatus : TUpsStatus read getUpsStatus;
 
84
      property Username : string read fUsername write setUsername;
 
85
      property Password : string read fPassword write setPassword;
 
86
      // in case login is set to true (and username,password are ok)
 
87
      // upsd knows that this system gets power from the ups and
 
88
      // will switch off only after login was set to false
 
89
      property Login : boolean read fLogin write doLogin;
 
90
      property Debug : boolean read fDebug write fDebug;
 
91
      property LastResult : string read fLastResponse;
 
92
      property numLogins : string read getNumLogins;
 
93
  end;
 
94
 
 
95
function UpsStatus2Txt (status : TUpsStatus) : string;
 
96
 
 
97
implementation
 
98
 
 
99
function TNutConnection.isConnected : boolean;
 
100
begin
 
101
  result := (fSock <> nil);
 
102
end;
 
103
 
 
104
procedure TNutConnection.doConnect (c : boolean);
 
105
begin
 
106
  if fSock <> nil then
 
107
  begin
 
108
    fSock.Free;
 
109
    fSock := nil;
 
110
    fLogin := false;
 
111
  end;
 
112
  if c then
 
113
    fSock := TInetSocket.Create (fHost, fPort);
 
114
end;
 
115
 
 
116
 
 
117
procedure TNutConnection.setHost (s : string);
 
118
begin
 
119
  if fHost <> s then
 
120
  begin
 
121
    fHost := s;
 
122
    doConnect (isConnected);
 
123
  end;
 
124
end;
 
125
 
 
126
procedure TNutConnection.setPort (w : word);
 
127
begin
 
128
  if w <> fPort then
 
129
  begin
 
130
    fPort := w;
 
131
    doConnect (isConnected);
 
132
  end;
 
133
end;
 
134
 
 
135
procedure TNutConnection.checkConnected;
 
136
begin
 
137
  if not isConnected then
 
138
    raise (TNutException.Create ('not connected'));
 
139
end;
 
140
 
 
141
procedure TNutConnection.sendCommand (s : string);
 
142
var len : longint;
 
143
begin
 
144
  checkConnected;
 
145
  if fDebug then
 
146
    writeln (stderr,'S: "'+s+'"');
 
147
  s := s + NutLineEnd;
 
148
  len := fSock.Write (s[1],length(s));
 
149
  if (len <> length(s)) then
 
150
  begin
 
151
    if fDebug then
 
152
      writeln (stderr,'send error');
 
153
    doConnect (false);
 
154
    raise (TNutException.Create ('send failed, disconnected from upsd'));
 
155
  end;
 
156
end;
 
157
 
 
158
function TNutConnection.getOneLine : string;
 
159
var c : char;
 
160
begin
 
161
  checkConnected;
 
162
  fLastResponse := '';
 
163
  result := '';
 
164
  while (fSock.read (c,1) = 1) do
 
165
  begin
 
166
    if c = NutLineEnd then
 
167
    begin
 
168
      if fDebug then
 
169
        writeln (stderr,'R: "'+result+'"');
 
170
      fLastResponse := result;
 
171
      exit;
 
172
    end;
 
173
    result := result + c;
 
174
  end;
 
175
end;
 
176
 
 
177
function TNutConnection.getVersion : string;
 
178
begin
 
179
  sendCommand ('VER');
 
180
  result := getOneLine;
 
181
end;
 
182
 
 
183
 
 
184
procedure TNutConnection.setUpsName (s : string);
 
185
var res : string;
 
186
begin
 
187
  fUpsName := '';
 
188
  sendCommand ('GET NUMLOGINS '+s);
 
189
  res := getOneLine;
 
190
  if copy (res,1,10) <> 'NUMLOGINS ' then
 
191
    Raise (TNutException.Create ('setUpsName, unknown response from upsd'));
 
192
  fUpsName := s;
 
193
end;
 
194
 
 
195
function TNutConnection.getValue (name : string) : string;
 
196
var s : string;
 
197
begin
 
198
  if fUpsName = '' then
 
199
    raise (TNutException.Create ('upsName not set'));
 
200
  sendCommand ('GET VAR '+fUpsName+' '+name);
 
201
  s := getOneLine;
 
202
  if s = 'ERR DATA-STALE' then
 
203
  begin
 
204
    result := s;
 
205
    exit;
 
206
  end;
 
207
  if copy (s,1,4) <> 'VAR ' then
 
208
    raise (TNutException.Create ('result from GET VAR invalid, does not begin with "VAR "'));
 
209
  delete (s,1,4);
 
210
  if ansiUpperCase (copy (s,1,length(fUpsName))) <> ansiUpperCase (fUpsName) then
 
211
    raise (TNutException.Create ('result from GET VAR invalid, second param was not upsName'));
 
212
  delete (s,1,length(fUpsName)+1);
 
213
  delete (s,1,length(name)+1);
 
214
  if copy (s,1,1) = '"' then delete (s,1,1);
 
215
  if copy (s,length(s),1) = '"' then delete (s,length(s),1);
 
216
  result := s;
 
217
end;
 
218
 
 
219
function TNutConnection.getUpsLoad : string;
 
220
begin
 
221
  result := getValue ('ups.load');
 
222
end;
 
223
 
 
224
function TNutConnection.getUpsMfr : string;
 
225
begin
 
226
  result := getValue ('ups.mfr');
 
227
end;
 
228
 
 
229
function TNutConnection.getUpsModel : string;
 
230
begin
 
231
  result := getValue ('ups.model');
 
232
end;
 
233
 
 
234
function TNutConnection.getUpsRuntime : string;
 
235
begin
 
236
  result := getValue ('battery.runtime');
 
237
end;
 
238
 
 
239
function TNutConnection.getUpsCharge : string;
 
240
begin
 
241
  result := getValue ('battery.charge');
 
242
end;
 
243
 
 
244
 
 
245
function TNutConnection.getUpsChargeInt : integer;
 
246
var s : string;
 
247
    p : integer;
 
248
begin
 
249
  try
 
250
    s := getUpsCharge;
 
251
    p := Pos ('.',s);
 
252
    if p > 0 then
 
253
      delete (s,p,255);
 
254
    result := StrToInt (s);
 
255
  except
 
256
    result := 100;
 
257
  end;
 
258
end;
 
259
 
 
260
function TNutConnection.getUpsTemperature : string;
 
261
begin
 
262
  result := getValue ('ups.temperature');
 
263
end;
 
264
 
 
265
function TNutConnection.getInputFrequency : string;
 
266
begin
 
267
  result := getValue ('input.frequency');
 
268
end;
 
269
 
 
270
function TNutConnection.getInputVoltage : string;
 
271
begin
 
272
  result := getValue ('input.voltage');
 
273
end;
 
274
 
 
275
function TNutConnection.getOutputVoltage : string;
 
276
begin
 
277
  result := getValue ('output.voltage');
 
278
end;
 
279
 
 
280
function TNutConnection.getNumLogins : string;
 
281
var res : string;
 
282
    p : integer;
 
283
begin
 
284
  if fUpsName = '' then
 
285
    Raise (TNutException.Create ('getNumLogins, upsName not set'));
 
286
  sendCommand ('GET NUMLOGINS '+fUpsName);
 
287
  res := getOneLine;
 
288
  if copy (res,1,10) <> 'NUMLOGINS ' then
 
289
    Raise (TNutException.Create ('setUpsName, unknown response from upsd'));
 
290
  delete (res,1,10);
 
291
  p := pos (' ',res);
 
292
  if p > 0 then
 
293
    delete (res,1,p);
 
294
  result :=res;
 
295
end;
 
296
 
 
297
function TNutConnection.getUpsStatus : TUpsStatus;
 
298
var s,value : string;
 
299
    i : integer;
 
300
begin
 
301
  try
 
302
    s := getValue ('ups.status');
 
303
    result := [];
 
304
    if s = NutDataStale then
 
305
      result := [UPS_stale]
 
306
    else
 
307
    repeat
 
308
      i := pos (' ',s);
 
309
      if (i > 0) then
 
310
      begin
 
311
        value := trim(ansiuppercase(copy(s,1,i-1)));
 
312
        delete (s,1,i); s:=trim(s);
 
313
      end else
 
314
      begin
 
315
        value := trim(ansiuppercase(s));
 
316
        s := '';
 
317
      end;
 
318
      if value = 'OL' then
 
319
        result := result + [UPS_online]
 
320
      else if value = 'OB' then
 
321
        result := result + [UPS_onBatt]
 
322
      else if value = 'LB' then
 
323
        result := result + [UPS_LowBatt]
 
324
      else if value = 'FSD' then
 
325
        result := result + [UPS_FSD];
 
326
    until s = '';
 
327
  except
 
328
    result := [UPS_disconnected];
 
329
  end;
 
330
end;
 
331
 
 
332
 
 
333
procedure TNutConnection.setUserName (user : string);
 
334
var res : string;
 
335
begin
 
336
  fUserName := user;
 
337
  if fUserName <> '' then
 
338
  begin
 
339
    sendCommand ('USERNAME '+user);
 
340
    res := getOneLine;
 
341
    if res <> 'OK' then
 
342
      raise (TNutException.Create (format ('username failed (%s)',[res])));
 
343
  end;
 
344
end;
 
345
 
 
346
procedure TNutConnection.setPassword (pwd : string);
 
347
var res : string;
 
348
begin
 
349
  fPassword := pwd;
 
350
  if pwd <> '' then
 
351
  begin
 
352
    sendCommand ('PASSWORD '+pwd);
 
353
    res := getOneLine;
 
354
    if res <> 'OK' then
 
355
      raise (TNutException.Create (format ('password failed (%s)',[res])));
 
356
  end;
 
357
end;
 
358
 
 
359
procedure TNutConnection.doLogin (login : boolean);
 
360
var res : string;
 
361
begin
 
362
  if login then
 
363
  begin
 
364
    if fLogin then
 
365
      raise (TNutException.Create ('already logged in'));
 
366
    if (fUsername = '') or (fPassword = '') or (fUpsName = '') then
 
367
      raise (TNutException.Create ('Login requires UpsName, Username and Password'));
 
368
    sendCommand ('LOGIN '+fUpsName);
 
369
    res := getOneLine;
 
370
    if res <> 'OK' then
 
371
      raise (TNutException.Create (format ('login failed (%s)',[res])));
 
372
    fLogin := true;
 
373
  end else
 
374
  if fLogin then
 
375
  begin
 
376
    sendCommand ('LOGOUT');
 
377
    res := getOneLine;
 
378
    if (copy(res,1,2) <> 'OK') and (copy(res,1,6)<> 'Goodby') then
 
379
      raise (TNutException.Create (format('logout failed, got "%s"',[res])));
 
380
    fLogin := false;
 
381
    doConnect(false);
 
382
  end;
 
383
end;
 
384
 
 
385
function UpsStatus2Txt (status : TUpsStatus) : string;
 
386
begin
 
387
  result := '';
 
388
  if UPS_disconnected in status then result := result + 'disconnected ';
 
389
  if UPS_stale        in status then result := result + 'stale ';
 
390
  if UPS_online       in status then result := result + 'online ';
 
391
  if UPS_onBatt       in status then result := result + 'onBattery ';
 
392
  if UPS_lowBatt      in status then result := result + 'LowBattery ';
 
393
  if UPS_FSD          in status then result := result + 'ForeceShutdown ';
 
394
  result := trim(result);
 
395
end;
 
396
 
 
397
 
 
398
end.