/pliant/fullpliant/user.page
 
 1  module "/pliant/language/stream.pli" 
 2  module "/pliant/admin/md5.pli" 
 3  module "/pliant/util/crypto/rsa.pli" 
 4  module "user.pli" 
 5  module "this_computer.pli" 
 6  module "login.pli" 
 7  module "/pliant/language/context.pli" 
 8   
 9  requires "browse_configuration" 
 10   
 11  method page detailed_history user day_count 
 12    arg_rw HtmlPage page ; arg Str user ; arg Int day_count 
 13    var DateTime now := datetime 
 14    (var Stream s) open "data:/pliant/login/"+user in+safe 
 15    while not s:atend 
 16      var Str l := s readline 
 17      if (l parse (var DateTime from) (var DateTime to) _ any:(var Str ip) _ any:(var Str comment)) 
 18        var Int old := now:date:days-from:date:days 
 19        if old<day_count 
 20          s unreadline l 
 21          var Date day := from date 
 22          if day_count=1 
 23            [Today detailed history:] 
 24          else 
 25            fixed (text string:day) 
 26            text " detailed history ("+string:old+" day"+(shunt old>1 "s" "")+" ago):" 
 27          table columns 4 
 28            cell header [From] 
 29            cell header [To] 
 30            cell header [IP address] 
 31            cell header [comment] 
 32            part scan_day 
 33              while not s:atend 
 34                var Str l := s readline 
 35                if (l parse (var DateTime from) (var DateTime to) _ any:(var Str ip) _ any:(var Str comment)) 
 36                  if from:date=day 
 37                    cell text:((string from) 11 5) 
 38                    cell text:((string to) 11 5) 
 39                    cell (text ip) 
 40                    cell (text comment) 
 41                  else 
 42                    s unreadline l 
 43                    leave scan_day 
 44            var Data:User2 u :> user_database2:data:user user 
 45            if u:from:date=day 
 46              cell text:((string u:from) 11 5) 
 47              cell text:((string u:to) 11 5) 
 48              cell (text u:ip) 
 49              cell (text u:comment) 
 50   
 51  title "Users administration" 
 52   
 53  para 
 54    note "Users database client and server global settings for this computer" 
 55      read_only not allowed:"administrator" 
 56      title "This computer users database settings" 
 57      table columns 1 
 58        cell header [Users database server computers] 
 59        each s this_computer:env:"pliant":"password" 
 60          if (keyof:s parse "server" any) 
 61            cell 
 62              text s 
 63      table columns 1 
 64        cell header [Users database client computers] 
 65        each c this_computer:env:"pliant":"password" 
 66          if (keyof:c parse "client" any) 
 67            cell 
 68              text c 
 69      if allowed:"administrator" 
 70        input "Computer name: " (var Str name) noeol 
 71        button "Add server" noeol 
 72          var Int num := 1 
 73          while exists:(this_computer:env:"pliant":"password" "server"+string:num) 
 74            num += 1 
 75          this_computer "pliant" "password" "server"+string:num := name 
 76          reload_page 
 77        button "Remove server" noeol 
 78          each s this_computer:env:"pliant":"password" 
 79            if (keyof:s parse "server" any) and s=name 
 80              this_computer:env:"pliant":"password" delete keyof:s 
 81          reload_page 
 82        button "Add client" noeol 
 83          var Int num := 1 
 84          while exists:(this_computer:env:"pliant":"password" "client"+string:num) 
 85            num += 1 
 86          this_computer "pliant" "password" "client"+string:num := name 
 87          reload_page 
 88        button "Remove client" 
 89          each c this_computer:env:"pliant":"password" 
 90            if (keyof:c parse "client" any) and c=name 
 91              this_computer:env:"pliant":"password" delete keyof:c 
 92          reload_page 
 93      para 
 94        button "Broadcast all users accounts" 
 95          each u user 
 96            user_update keyof:u 
 97          reload_page 
 98      para 
 99        [The rule is fairly simple: when a change is applied on a user account on one of the servers, it is automatically propagated to various clients.] ; eol 
 100        [Changes to accounts with 'administrator' right are not propagated.] 
 101   
 102   
 103  [List of currently defined users:] 
 104   
 105  table columns 5 
 106    cell header 
 107      [User ID] 
 108    cell header 
 109      [First name] 
 110    cell header 
 111      [Name] 
 112    cell header 
 113      [Description] 
 114    cell 
 115      void 
 116    each u user 
 117      var Str id := keyof u 
 118      cell 
 119        text id 
 120      cell 
 121        text u:first_name 
 122      cell 
 123        text u:name 
 124      cell 
 125        text u:abstract 
 126        if u:homepage<>"" 
 127          small 
 128            eol ; link "Homepage" u:homepage 
 129      cell 
 130        page button "Edit" 
 131          read_only not allowed:"administrator" 
 132          title "User '"+id+"'" 
 133          table columns 3 border 0 
 134            cell 
 135              [User ID:] 
 136            cell 
 137              fixed text:id 
 138            cell 
 139              [The string the user uses to authenticate in the computer.] ; eol 
 140              [An example is] ; fixed [ helene.tonneau] 
 141            cell 
 142              [First name:] 
 143            cell 
 144              input "" u:first_name 
 145            cell void 
 146            cell 
 147              [Name:] 
 148            cell 
 149              input "" u:name 
 150            cell 
 151              [The human readable name of the user.] ; eol 
 152              [An example is] ; fixed [ H鬨ne Tonneau] 
 153            cell 
 154              [Email:] 
 155            cell 
 156              input "" u:email 
 157            cell 
 158              [You may leave it blank if you prefer.] 
 159            cell 
 160              [Home page:] 
 161            cell 
 162              input "" u:homepage 
 163            cell 
 164              [You may leave it blank if you prefer.] 
 165            cell 
 166              [Contact:] 
 167            cell 
 168              text_input "" u:contact rows 5 columns 40 
 169            cell 
 170              [Other ways to contact this user (phone, fax, postal address, ...)] 
 171            cell 
 172              [Password:] 
 173            cell 
 174              if allowed:"administrator" 
 175                input "" (var Str password) password 
 176            cell 
 177              [In the users database, only the MD5 digest of the password is stored.] 
 178            cell 
 179              [Public key:] 
 180            cell 
 181              input "" u:public_key length 30 noeol 
 182              if allowed:"administrator" 
 183                button "Generate" 
 184                  title "Generate a public/private key pair for '"+id+"'" 
 185                  var Int bits := 1024 
 186                  input "Number of bits: " bits length 4 
 187                  input "Key password: " (var Str password) password noeol 
 188                  button "Generate now" 
 189                    rsa_generate "user:"+id bits password 
 190                    goto_backward 
 191                  para 
 192                    [Generating a long key pair will take a very long time. ] 
 193                    [Let's say one hour for a 1024 bits key on a 300Mhz computer. ] 
 194                    [If the key length is double, then the consumed time will be roughly multiplyed by five.] 
 195                var Int bits := rsa_nbbits u:public_key 
 196                if bits=defined 
 197                  small 
 198                    eol ; [The current key is ] ; text string:bits ; [ bits wild.] 
 199            cell 
 200              [] 
 201            cell 
 202              [Language:] 
 203            cell 
 204              input "" u:language length 2 
 205            cell 
 206              [] 
 207            cell 
 208              [Options:] 
 209            cell 
 210              input "" u:options length 40 
 211            cell 
 212              [Options might be parsed by some specific applications.] 
 213            cell 
 214              [Styling options:] 
 215            cell 
 216              input "" u:style_options length 40 
 217            cell 
 218              [More options used for specifying user viewing preferences.] 
 219            cell 
 220              [Unix user ID:] 
 221            cell 
 222              input "" u:uid 
 223            cell 
 224              [] 
 225            cell 
 226              [Computer:] 
 227            cell 
 228              input "" u:computer 
 229            cell 
 230              [If you specify a Unix user ID and computer, then installed the specifyed computer with FullPliant, then a Unix user will be created.] 
 231          table columns 2 border 0 
 232            cell [Description:] 
 233            cell (text_input "" u:abstract rows 5 columns 60) 
 234   
 235          [The following table enables you to grant rights to the user:] 
 236          table columns 5 
 237            cell header [Line ID] 
 238            cell header [Authentification mechanism] 
 239            cell header [Client IP] 
 240            cell header [Computers names] 
 241            cell header [Granted right] 
 242            cell header 
 243              small 
 244                [Must be unique, but does not have any meaning.] 
 245            cell header 
 246              small 
 247                [The right will be granted only if the connection mecanism/protocol used by the user is at least as secured as the one specifyed here.] 
 248            cell header 
 249              small 
 250                [If not empty, the right will be granted only if the user is connecting from within the specifyed IP areas.] ; eol 
 251                note "extra details" 
 252                  title "Client IP field" 
 253                  [This is used to restrict the computers the user is allowed to connect from. ] 
 254                  [As an example, you may want to specify that a use can connect from the intranet, but not from the Internet.] 
 255                  para 
 256                    [An axample can be:] ; fixed [ 127.0.0.1 10.30.144.0/255.255.255.0 ] ; eol 
 257                    [and it means either 127.0.0.1 or 10.30.144.xxx IP address.] 
 258            cell header 
 259              small 
 260                [If not empty, the right will be granted only if connecting to one of the listed servers.] ; eol 
 261                note "extra details" 
 262                  title "Server names field" 
 263                  [You must list the real names of the server computers, not the logical names you use to access these.] 
 264            cell header 
 265              small 
 266                [This is the name of the right you are granting to the user. It must match the name specifyed in the 'Read' column of the web sites areas configuration.] ; eol 
 267                [See ] ; link "security section" "/pliant/protocol/http/" section "security" ; [ in the HTTP server documentation for predifined rights meanings.] 
 268            each r u:right 
 269              cell 
 270                text keyof:r 
 271              cell 
 272                select "" r:auth 
 273                  option "None" "0" 
 274                  option "Clear password" "1" 
 275                  option "Chalenge password" "2" 
 276                  option "Strong crypto" "3" 
 277              cell 
 278                input "" r:ip length 16 
 279              cell 
 280                input "" r:server length 16 
 281              cell 
 282                input "" r:right 
 283                if r:right="read" or r:right="write" 
 284                  highlight "You should not use 'read' or 'write' in configuration tables." 
 285          if allowed:"administrator" 
 286            input "Line ID: " (var Str rid) length 10 noeol 
 287            button "Create one new line" noeol 
 288              u:right create rid 
 289              reload_page 
 290            button "Delete the line" 
 291              u:right delete rid 
 292              reload_page 
 293   
 294          [Add all the rights defined in some template accounts:] 
 295          table columns 2 
 296            cell header [Line ID] 
 297            cell header [Template account] 
 298            each t u:template 
 299              cell 
 300                text keyof:t 
 301              cell 
 302                input "" t length 30 
 303          if allowed:"administrator" 
 304            input "Line ID: " (var Str tid) length 10 noeol 
 305            button "Add a line" noeol 
 306              u:template create tid 
 307              reload_page 
 308            button "Remove a line" 
 309              u:template delete tid 
 310              reload_page 
 311     
 312          [The following table enables you to assign maiboxes to this user so that he can use these from Pliant web site:] 
 313          table columns 2 
 314            cell header [Line ID] 
 315            cell header [Mailbox] 
 316            each m u:mailbox 
 317              cell 
 318                text keyof:m 
 319              cell 
 320                input "" m length 30 
 321          if allowed:"administrator" 
 322            input "Line ID: " (var Str mid) length 10 noeol 
 323            button "Add a line" noeol 
 324              u:mailbox create mid 
 325              reload_page 
 326            button "Remove a line" 
 327              u:mailbox delete mid 
 328              reload_page 
 329     
 330            para 
 331              page button "Update user informations" 
 332                if password<>"" 
 333                  user_secret_database:data:user create id 
 334                  user_secret_database:data:user:id password_md5 := string_md5_hexa_signature password 
 335                var CBool ok := true 
 336                each c this_computer:env:"pliant":"password" 
 337                  if (keyof:c parse "client" any) and c<>computer_fullname 
 338                    if (user_update id u:first_name u:name u:email u:abstract user_secret_database:data:user:id:password_md5 u:public_key u:language u:options u:style_options c)=failure 
 339                      text "Failed to forward changes to server "+c ; eol 
 340                      ok := false 
 341                if ok 
 342                  goto_backward 
 343            para 
 344              var Int dc := 7 
 345              button "Display '"+id+"' log history" noeol 
 346                title (string dc)+" days history for '"+id+"' account" 
 347                detailed_history id dc 
 348              input " on " dc length 2 noeol ; [ days] 
 349   
 350  if allowed:"administrator" 
 351    input "User ID: " (var Str uid) noeol 
 352    button "Create the new user" noeol 
 353      user create uid 
 354      user_database2:data:user create uid 
 355      user_secret_database:data:user create uid 
 356      reload_page 
 357    page button "Delete the user" 
 358      var CBool ok := true 
 359      each c this_computer:env:"pliant":"password" 
 360        if (keyof:c parse "client" any) and c<>computer_fullname 
 361          if (user_delete uid c)=failure 
 362            text "Failed to delete '"+uid+"' user on server "+c ; eol 
 363            ok := false 
 364      if ok 
 365        user delete uid 
 366        user_database2:data:user delete uid 
 367        user_secret_database:data:user delete uid 
 368        reload_page 
 369      else 
 370        data_reset user_database:data:user:uid:right 
 371   
 372  para 
 373    input "Right: " (var Str right) noeol 
 374    button "Find users having this right" 
 375      title "List of users with '"+right+"' right" 
 376      table columns 4 
 377        cell header [User] 
 378        cell header [Authentification mechanism] 
 379        cell header [Client IP] 
 380        cell header [Computers names] 
 381        each u user 
 382          each r u:right 
 383            if r:right=right 
 384              read_only 
 385                cell (text keyof:u) 
 386                cell 
 387                  select "" r:auth 
 388                    option "None" "0" 
 389                    option "Clear password" "1" 
 390                    option "Chalenge password" "2" 
 391                    option "Strong crypto" "3" 
 392                cell 
 393                  input "" r:ip length 16 
 394                cell 
 395                  input "" r:server length 16 
 396   
 397  if not (exists user:"anonymous") 
 398    para 
 399      [You should create an] ; fixed [ anonymous ] ; [user for defining the rights users that are not logged in are granted.] ; eol 
 400